Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Grupo de Teaming del ClubDelphi

 
 
Herramientas Buscar en Tema Desplegado
  #2  
Antiguo 17-07-2006
Avatar de ixMike
ixMike ixMike is offline
Miembro
 
Registrado: feb 2004
Posts: 1.151
Poder: 22
ixMike Va por buen camino
Lo Tengooooooooooooooooooooooooooo

¡¡¡Lo logré!!!
Primero creé un tipo de objeto parecido al TStrinList, pero que almacena integers en vez de strings. Aquí está el código de la unidad:
Código Delphi [-]
unit Integers;
interface
uses
  Classes;
type
  TIntArray = array [0..0] of Integer;
  PIntArray = ^TIntArray;
  TIntegers = class(TObject)
    protected
    FIntegers: PIntArray;
    FCount: Integer;
    Function GetIntegers(Index: Integer): Integer;
    Procedure SetIntegers(Index: Integer; valor: Integer);
    
    public
    Procedure Add(I: Integer);
    Procedure Clear;
    Procedure Delete(Index: Integer);
    Function IndexOf(I: Integer): Integer;
    Property Count: Integer read FCount;
    Property Values[Index: Integer]: Integer read GetIntegers write SetIntegers;
    Constructor Create;
    Destructor Destroy; override;
    end;
implementation
Constructor TIntegers.Create;
begin
inherited;
GetMem(FIntegers, 0);
FCount:=0;
end;
Destructor TIntegers.Destroy;
begin
FreeMem(FIntegers, FCount * SizeOf(Integer));
inherited;
end;
Procedure TIntegers.Add(I: Integer);
begin
Inc(FCount);
ReallocMem(FIntegers, FCount * SizeOf(Integer));
FIntegers^[FCount-1]:=I;
end;
Procedure TIntegers.Delete(Index: Integer);
var
n: integer;
begin
If FCount=0 then exit;
for n:=Index+1 to FCount-1 do FIntegers^[n-1]:=FIntegers^[n];
Dec(FCount);
ReallocMem(FIntegers, FCount * SizeOf(Integer));
end;
Procedure TIntegers.Clear;
begin
FCount:=0;
ReallocMem(FIntegers, 0);
end;
Function TIntegers.GetIntegers(Index: Integer): Integer;
begin
If Index<=FCount then Result:=FIntegers^[Index];
end;
Function TIntegers.IndexOf(I: Integer): Integer;
var
n: integer;
begin
Result:=-1;
If FCount=0 then exit;
For n:=0 to FCount-1 do If FIntegers^[n]=I then
  begin
  Result:=n;
  exit;
  end;
end;
Procedure TIntegers.SetIntegers(Index: Integer; Valor: Integer);
begin
If index<=FCount then FIntegers^[Index]:=Valor;
end;
end.
Después creé un par de DLLs de ejemplo, con tres funciones que devuelven el nombre de la misma, la versión y el nombre del programador.
Para comprobar que funcionaban, en un nuevo proyecto coloqué un TListView con cuatro columnas (Archivo, nombre, versión, autor). En ella se tendría que listar el nombre de las DLLs encontradas en el directorio de la aplicación y el resultado de las funciones GetName, GetVersion y GetAuthor de las librerías de ejemplo que hice.
Además, las cargo al inicio del programa y las libero al final. Aquí está el códido del programa:
Código Delphi [-]
unit PruebaMain;
interface
uses
  Windows, Forms, ComCtrls, Controls, Classes, SysUtils, Integers;
type
  TGetVersionFunc = function : String; stdcall;
  TGetNameFunc = function : String; stdcall;
  TGetAuthorFunc = function : String; stdcall;
  TForm1 = class(TForm)
    ldlls: TListView;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
  ints: TIntegers;
  vGetName: TGetNameFunc = nil;
  vGetVersion: TGetVersionFunc = nil;
  vGetAuthor: TGetAuthorFunc = nil;
implementation
{$R *.DFM}
Function LiberarLibreria(manejador: Integer): integer;
begin
if manejador<>0 then FreeLibrary(manejador);
Result:=Manejador;
end;
Function CargarLibreria(dll: string): Integer;
begin
Result:=LoadLibrary(PChar(dll));
end;
Function GetName(h: integer): String;
begin
@vGetName:=GetProcAddress(h,'GetName');
if @vGetName <> nil then Result:=vGetName else result:='Error loading library';
end;
Function GetVersion(h: integer): String;
begin
@vGetVersion:=GetProcAddress(h,'GetVersion');
if @vGetVersion <> nil then Result:=vGetVersion else result:='Error loading library';
end;
Function GetAuthor(h: integer): String;
begin
@vGetAuthor:=GetProcAddress(h,'GetAuthor');
if @vGetAuthor <> nil then Result:=vGetAuthor else result:='Error loading library';
end;
procedure TForm1.FormCreate(Sender: TObject);
var
encontrado, n: integer;
archivo: TSearchRec;
nodo: TListItem;
begin
LDLLs.Items.Clear;
// Busca archivos DLL en el mismo directorio
encontrado:=FindFirst(ExtractFilePath(ParamStr(0))+'*.dll',faAnyFile,archivo);
while encontrado=0 do
  begin
  nodo:=ldlls.Items.Add;
  nodo.Caption:=archivo.name;
  encontrado:=FindNext(archivo);
  end;
FindClose(archivo);
////////////
If LDLLs.Items.Count=0 then exit; //Si no ha encontrado DLLs sale
// Asignar handles
ints:=TIntegers.Create;
for n:=0 to LDlls.ITems.Count-1 do
 ints.Add(CargarLibreria(Ldlls.Items[n].caption));
///////////
// Ejecutar funciones
for n:=0 to LDlls.ITems.Count-1 do
  begin
  Ldlls.Items[n].Subitems.Clear;
  Ldlls.Items[n].Subitems.Add(GetName(ints.values[n]));
  Ldlls.Items[n].Subitems.Add(GetVersion(ints.values[n]));
  Ldlls.Items[n].Subitems.Add(GetAuthor(ints.values[n]));
  end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
n: integer;
begin
for n:=0 to ints.Count-1 do ints.values[n]:=LiberarLibreria(ints.values[n]);
ints.Free;
end;
end.
Espero que esto le sirva de ayuda a alguien.
Responder Con Cita
 



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
StarTeam, ese desconocido [Gunman] Varios 5 31-01-2007 18:10:54
DLL con nombre desconocido ixMike Varios 2 28-06-2006 11:05:02
Caracter desconocido... Xianto Varios 3 07-01-2005 15:46:08
Es un camino desconocido Oxa78 Varios 11 25-11-2004 09:47:03
Error Desconocido - Ayuda Por Favor LucasArgentino Conexión con bases de datos 1 12-12-2003 12:49:25


La franja horaria es GMT +2. Ahora son las 21:12:23.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi