Problemita DLL

[NeWNeO]

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.



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; // cargar un dll
begin
Result := 0;
if LoadLibrary(PChar(fLibDir+dllname)) = 0 then exit;
result := GetModuleHandle(PChar(dllname));
fLibHandle := result;
end;



function TDLLControl.DeallocateDLL(DLLHandle: THandle):boolean; // liberar un dll
begin
FreeLibrary(DLLHandle);
end;

function TDLLControl.CheckFunction(lib: THandle;FuncName: string;var p: pointer):boolean; // para comprobar funciones
begin
// Parametros por defecto
Result := false;
p := nil;
// Comprobamos la función en el dll
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:


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


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?

[delphi.com.ar]

function Test(Sender: TObject): string;
begin
result := 'Test OK, Ready!';
end;
Yo pensaría en replantear el tipo de dato, y si quieres pasar clases, te recomendaría utilizar BPL´s en lugar de DLL´s.

Saludos!

[jachguate]

Yo pensaría en replantear el tipo de dato
Es que hay un sabido inconveniente entre los Strings al estilo delphi y las DLL's. Podes usar pchar, o bien strings al estilo pascal (sin contador de referencias y memoria dinámica, pero limitados a 255 caracteres).

Si insistis en usar strings, mirate la ayuda de la unidad ShareMem.

y si quieres pasar clases, te recomendaría utilizar BPL´s en lugar de DLL´s.

Pues yo he usado dll's sin mayores problemas, pero tampoco muy extensamente... ¿porque bpl's y do dll's?

Hasta luego.

;)

[NeWNeO]

He modificado String por PChar y si que se envia el resultado, pero una vez gestionado saca un error, pero esta vez en lugar de en el dll en el archivo exe...



procedure TForm1.RunClick(Sender: TObject);
var
h: THandle;
title: function(Sender: TObject):PChar; stdcall;
begin
DLLControl1.LibDir := GetCurrentDir;
h := DLLControl1.AllocateDLL('dllfile.dll');
if h = 0 then showmessage('File not found');
if DLLControl1.CheckFunction(h,'Test',@title) then showmessage(Title(Self)) else showmessage('Process not found');
DLLControl1.DeallocateDLL(h);
end;



Gracias

[delphi.com.ar]

¿porque bpl's y do dll's?
Simplemente porque las BPL´s han sido diseñadas con este propósito... No se que pasará con el versionamiento en DLL´s comunes, supongo que es un access violation asegurado :D.

[NeWNeO]

He eliminado el Stdcall de la función y ahora funciona al 100% usando PAnsiChar.
:D

title: function(Sender: TObject):PAnsiChar; Stdcall;