Gracias a todos por los consejos, pero mi supina ignorancia en temas avanzados de Delphi me han llevado a cometer un error de principiante
. El problema se ha solucionado SIMPLEMENTE asignando la funcion tipo TFMensajes a una variable que habia declarado en el procedimiento. Ahora funciona perfectamente ... si no fuera por que al terminar el procedimiento se genera otra excepcion: "Access violation at 0x004308D8. Read of address 0x00000000". He probado varias cosas, pero no funciona ninguna. Supongo que es algun puntero que no libero o que hace falta algo mas para descargar la dll de la memoria.
Código Delphi
[-]
unit uEGDB;
interface
uses
Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,
Dialogs,StdCtrls;
type
TForm1=class(TForm)
btnIdentificarTF:TButton;
memResultados:TMemo;
procedure btnIdentificarTFClick(Sender:TObject);
private
public
end;
var
Form1:TForm1;
implementation
uses
uTiposEGDB;
type
TFMensajes = procedure(texto: pAnsiChar); cdecl;
var
HandleDLL: THandle;
IdentificarTablaFinales: function(directory: pAnsiChar;
var db_type: EGDB_TYPE; var max_pieces: Integer)
:integer; stdcall;
AbrirTablaFinales: function(bitmap_type: EGDB_BITMAP_TYPE;
pieces,cache_mb: Integer; directory: pAnsiChar;
FMensajes: TFMensajes):PEGDB_DRIVER; cdecl;
FicheroTexto: TextFile;
{$R *.dfm}
procedure FMensaje(texto: pAnsiChar); cdecl;
begin
Append(FicheroTexto);
Write(FicheroTexto,texto);
CloseFile(FicheroTexto);
end;
function DescripcionTipoEGDB(tipo: EGDB_TYPE): string;
begin
case tipo of
EGDB_KINGSROW_WLD: result:='KingsRow WLD';
EGDB_KINGSROW_MTC: result:='KingsRow MTC';
EGDB_CAKE_WLD: result:='Cake WLD';
EGDB_CHINOOK_WLD: result:='Chinook WLD';
EGDB_KINGSROW32_WLD: result:='KingsRow32 WLD';
EGDB_KINGSROW32_MTC: result:='KingsRow32 MTC';
EGDB_CHINOOK_ITALIAN_WLD: result:='Chinook Italian WLD ';
EGDB_KINGSROW32_ITALIAN_WLD: result:='KingsRow32 Italian WLD';
EGDB_KINGSROW32_ITALIAN_MTC: result:='KingsRow32 Italian MTC';
end;
end;
procedure TForm1.btnIdentificarTFClick(Sender:TObject);
var
directorio: pAnsiChar;
TipoEGDB: EGDB_TYPE;
HandleEGDB: PEGDB_DRIVER;
IdentificacionCorrecta,piezas: Integer;
Funcion: TFMensajes;
cerrar: Integer;
liberar: boolean;
begin
HandleDLL:=LoadLibrary('egdb.dll');
if HandleDLL>32 then begin
@IdentificarTablaFinales:=GetProcAddress(HandleDLL,'egdb_identify');
@AbrirTablaFinales:=GetProcAddress(HandleDLL,'egdb_open');
end;
if assigned(IdentificarTablaFinales) then begin
directorio:='c:\damas\damas\egdb3\cake';
IdentificacionCorrecta:=IdentificarTablaFinales(directorio,TipoEGDB,piezas);
end;
if IdentificacionCorrecta=0 then begin
memResultados.Lines.Add('Tipo EGDB: '+DescripcionTipoEGDB(TipoEGDB));
memResultados.Lines.Add('Piezas: '+inttostr(piezas));
end;
if assigned(AbrirTablaFinales) then begin
Funcion:=FMensaje; HandleEGDB:=AbrirTablaFinales(EGDB_NORMAL,piezas,30,directorio,Funcion);
end;
@funcion:=nil;
@IdentificarTablaFinales:=nil;
@AbrirTablaFinales:=nil;
cerrar:=HandleEGDB.close(HandleEGDB);
if cerrar=0 then
memResultados.Lines.Add('EGDB cerrada: '+inttostr(cerrar));
HandleEGDB:=nil;
freeandnil(HandleEGDB);
liberar:=FreeLibrary(HandleDLL);
if liberar then
memResultados.Lines.Add('DLLEGDB liberada: '+inttostr(cerrar));
end;
initialization
AssignFile(FicheroTexto,'FicheroEGDB.txt');
Rewrite(FicheroTexto);
finalization
end.