Teniendo en cuenta que en anteriores mensajes no he conseguido exponer de una forma clara mi problema, voy a ver si puedo ahora hacerlo. Gracias a todos los que ayudan ;D
Bien, quiero crear una serie de librerias para mi aplicación. El sistema utiliza un vcl que carga y descarga las dll's, además de comprobar si el proceso/función está disponible en él.
Código Delphi
[-]
unit DllControl;
interface
uses Classes, SysUtils, Dialogs, Windows;
type
TDLLControl = Class(TComponent)
private
fLibDir : string;
fLibHandle : THandle;
procedure SetLibDir(LibDir: string);
public
Constructor Create(AOwner: TComponent); override;
Destructor Destroy;
function AllocateDLL(dllname: string): THandle;
function CheckFunction(lib: THandle;FuncName: string; var p: pointer):boolean;
function DeallocateDLL(DLLHandle: THandle):boolean;
property LastLibHandle: THandle read fLibHandle;
published
property LibDir: string read fLibDir write SetLibDir;
protected
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('System', [TDLLControl]);
end;
Constructor TDLLControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
end;
Destructor TDLLControl.Destroy;
begin
inherited Destroy;
end;
function TDLLControl.AllocateDLL(dllname: string): THandle; begin
Result := 0;
if LoadLibrary(PChar(fLibDir+dllname)) = 0 then exit;
result := GetModuleHandle(PChar(dllname));
fLibHandle := result;
end;
function TDLLControl.DeallocateDLL(DLLHandle: THandle):boolean; begin
FreeLibrary(DLLHandle);
end;
function TDLLControl.CheckFunction(lib: THandle;FuncName: string;var p: pointer):boolean; begin
Result := false;
p := nil;
if lib <> 0 then
begin
p := GetProcAddress(lib, PChar(funcname));
if p <> nil then Result := true;
end;
end;
procedure TDLLControl.SetLibDir(LibDir: string);
begin
if (Copy(LibDir,length(LibDir),1) <> '\') then
if (Copy(LibDir,length(LibDir),1) = '/') then fLibDir := LibDir;
fLibDir := LibDir + '\';
end;
end.
Y uso este DLL:
Código Delphi
[-]
library DLLFile;
uses
SysUtils, Dialogs,
Classes;
{$R *.res}
function Test(Sender: TObject): string;
begin
result := 'Test OK, Ready!';
end;
procedure Test2(Sender: TObject);
begin
showmessage('Procedure OK');
end;
Exports Test, Test2;
end.
Creo una aplicación, inserto el componente y pongo correctamente la dirección del dll, comprobando luego la función y ejecutandola
Código Delphi
[-]
procedure TForm1.Button1Click(Sender: TObject);
var
h: THandle;
title: function(Sender: TObject):string; stdcall;
begin
DLLControl1.LibDir := GetCurrentDir;
h := DLLControl1.AllocateDLL('dllfile.dll');
if DLLControl1.CheckFunction(h,'Test',@title) then Title(Self);
DeallocateDLL(h);
end;
Como ya he dicho (y he comprobado), la libreria se carga, la función existe, pero aparece un mensaje de error a la hora de ejecutar:
"Project DLLTest.exe raised exception EAccessViolation with Message 'Access violation at adress xxxxx in 'dllfile.dll'. Write of adress xxxxx blablabla"
¿No consigo encontrar la causa de este error, alguien me puede ayudar?