Ver Mensaje Individual
  #2  
Antiguo 17-07-2006
Avatar de ixMike
ixMike ixMike is offline
Miembro
 
Registrado: feb 2004
Posts: 1.151
Reputación: 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