Acceso a DLL

aggg63 · #1 03-09-2005

Hola.

Estoy desarrollando un motor para jugar a las damas españolas http://www.terra.es/personal9/aggg63/damas/damas.htm con la interficie CheckerBoard http://www.fierz.ch/checkers.htm de Martin Fierz. Ed Gilbert ha desarrollado una DLL que accede a las bases de datos de finales de las damas americanas http://pages.prodigy.net/eyg/Checkers/egdb_rev3.zip. He creado un pequeño programa que intenta acceder a las bases de datos, pero no me carga bien las funciones que exporta la DLL. A continuacion teneis un resumen de las unidades que uso. La primera funcion me identifica la base de datos pero cuando intento abrir un handle con la segunda, me da un error. ¿Alguien puede ayudarme un poco? Gracias.

Código Delphi [-] unit uTiposEGDB;
 
 interface
 
 const
   // Color definitions
   EGDB_BLACK = 0; EGDB_WHITE = 1;
   // Values returned by handle->lookup()
   EGDB_UNKNOWN = 0; // value not in the database
   EGDB_WIN = 1; EGDB_LOSS = 2; EGDB_DRAW = 3;
   EGDB_NOT_IN_CACHE = 4; // conditional lookup and position not in cache
   // MTC macros
   MTC_THRESHOLD = 10; MTC_LESS_THAN_THRESHOLD = 1;
   MTC_UNKNOWN = 0;
 
 type
   // Tipos de tablas de finales
   EGDB_TYPE = ( EGDB_KINGSROW_WLD=0, EGDB_KINGSROW_MTC,
   EGDB_CAKE_WLD, EGDB_CHINOOK_WLD,
   EGDB_KINGSROW32_WLD, EGDB_KINGSROW32_MTC,
   EGDB_CHINOOK_ITALIAN_WLD, EGDB_KINGSROW32_ITALIAN_WLD,
   EGDB_KINGSROW32_ITALIAN_MTC);
   // for database lookup stats
   EGDB_STATS = record
   lru_cache_hits,lru_cache_loads,autoload_hits,db_requests,
   db_returns, db_not_present_requests: cardinal;
 end;
 
   EGDB_BITMAP_TYPE = (EGDB_NORMAL=0, EGDB_ROW_REVERSED);
   // This is KingsRow's definition of a checkers position.
   EGDB_NORMAL_BITMAP = record
   black,white,king: cardinal;
 end;
 
   // This is Cake's definition of a board position.
   EGDB_ROW_REVERSED_BITMAP = record
   black_man,black_king,white_man,white_king: cardinal;
 end;
 
   EGDB_BITMAP = record
   case integer of
     0: (normal: EGDB_NORMAL_BITMAP);
     1: (row_reversed: EGDB_ROW_REVERSED_BITMAP);
   end;
   PEGDB_BITMAP = ^EGDB_BITMAP;
   PEGDB_STATS = ^EGDB_STATS;
   // The driver handle type
   PEGDB_driver = ^TEGDB_driver;
   TEGDB_driver = record
   lookup: function (handle: PEGDB_driver; position: PEGDB_BITMAP;
   color: integer; cl: integer):longint; cdecl;
   reset_stats: procedure (handle: PEGDB_driver);
   get_stats: function (handle: PEGDB_driver): PEGDB_STATS;
   verify: function (handle: PEGDB_driver): integer;
   close: function (handle: PEGDB_driver): integer;
   internal_data: pointer;
 end;
 
 type
   TFMensajes = procedure(texto: pAnsiChar); cdecl;
 
 var
   FicheroTexto: TextFile;
   HandleDLL: THandle;
   function IdentificarTablaFinales(directory: pAnsiChar;
     var db_type: EGDB_TYPE; var max_pieces: Integer):integer; stdcal;
   function AbrirTablaFinales(bitmap_type: EGDB_BITMAP_TYPE; pieces,
     cache_mb: Integer;directory: pAnsiChar; FMensajes: TFMensajes) : PEGDB_DRIVER;
       cdecl; external 'egdb.dll' index 6;
 
 procedure FMensaje(texto: pAnsiChar); cdecl;
 begin
   AssignFile(FicheroTexto,'FicheroEGDB.txt');
   Rewrite(FicheroTexto);
   Write(FicheroTexto,texto);
   CloseFile(FicheroTexto);
 end;
 
 function CargarFuncionDLL(FicheroDLL: String; var HandleDLL:
   THandle; Nombre: String; Indice: Integer=-1) :Pointer;
 begin
   Result:=nil;
   HandleDLL:=0;
   HandleDLL:=LoadLibrary(pAnsiChar(FicheroDLL));
   If HandleDLL=0 then Exit;
   If Indice<0 then
     Result:=GetProcAddress(HandleDLL,pAnsiChar(Nombre))
   else
     Result:=GetProcAddress(HandleDLL,pAnsiChar(Indice));
 end;
 
 function DescripcionTipoEGDB(tipo: EGDB_TYPE):string;
 begin
   case tipo of
     EGDB_KINGSROW_WLD: result:='KingsRow WLD';
     EGDB_KINGSROW_MTC: result:='KingsRow MTC';
   end;
 end;
 
 procedure TForm1.btnIdentificarTFClick(Sender:TObject);
 var
   directorio: pAnsiChar;
   TipoEGDB: EGDB_TYPE;
   HandleEGDB: PEGDB_DRIVER;
   piezas: Integer;
   tipo: Integer;
   FMensajes: TFMensajes;
 begin
   HandleDLL:=LoadLibrary('egdb.dll');
   IdentificarTablaFinales:=CargarFuncionDLL'egdb.dll',HandleDLL,'egdb_identify');
   directorio:='c:\damas\damas\egdb\cake';
   IdentificarTablaFinales(directorio,TipoEGDB,piezas);
   memResultados.Lines.Add('Tipo EGDB: '+DescripcionTipoEGDB(TipoEGDB));
   memResultados.Lines.Add('Piezas: '+inttostr(piezas));
   AbrirTablaFinales:=CargarFuncionDLL('egdb.dll',HandleDLL,'egdb_open',6);
   // ERROR AL EJECUTAR LA SIGUIENTE LINEA
   HandleEGDB:=AbrirTablaFinales(EGDB_NORMAL,piezas,300,directorio,FMensajes);
   FreeLibrary(HandleDLL);
 end;

aggg63 · #2 03-09-2005

Eliminar la linea

HandleDLL:=LoadLibrary('egdb.dll');

del procedimiento

procedure TForm1.btnIdentificarTFClick(Sender:TObject);

Disculparme, estoy usando 2 formas de acceder a la libreria y se ha colado codigo que no uso ahora.

dec · #3 03-09-2005

Hola,

aggg63, he editado tu mensaje para encerrar el código fuente dentro de la etiqueta [ DELPHI ]. Por favor, en sucesivas ocasiones utiliza dicha etiqueta, pues, como puedes apreciar, el código fuente pasa a ser más legible, al menos. ¿Cómo puedes hacer uso de la etiqueta [ DELPHI ]? Así:

[ DELPHI ]
// Tu código fuente aquí
[ DELPHI ]

Observa que incluyo espacios dentro de la etiqueta porque de no ser así no podría explicarte su uso. Tampoco estaría demás, aparte de lo dicho, que echaras un vistazo a la guía de estilo de los Foros, fíjate en el apartado "Títulos descriptivos para los mensajes". Por otra parte sé bienvenido.

droguerman · #4 03-09-2005

intenta esto:

Código Delphi [-] TFMensajes = procedure(texto: pAnsiChar); stdcall;

y la funcion freeLibrary usala solo cuando estes seguro que no vas a volver a hacer una llamada a loadlibrary de esa DLL sino resultará en una violación de acceso

aggg63 · #5 04-09-2005

Hola.

He probado casi todas las opciones stdcall, cdecl, safecall, etc. Sigue sin funcionar cuando intento acceder a la funcion HandleEGDB. No soy un experto en Delphi, siento insistir en el problema. Para aclarar ideas he desarrollado 2 versiones del programa. Una carga la libreria estaticamente y otra la carga dinamicamente. En separados mensajes pongo los codigos de ambas versiones. La unidad comun uTiposEGDB esta en otro mensaje para no cargar demasiado este. Si esta permitido, puedo enviar 2 ficheros zip con todos los ficheros de los proyectos. Ocupan unos 70KB por proyecto, sin los ficheros de las bases de datos que consulta la libreria. Estos se encuentran en CheckerBoard o en KingsRow.

Gracias dec por la modificacion y por la sugerencia. Sin embargo, he consultado la guia de estilo y no he encontrado referencias a la la etiqueta DELPHI. Creo que seria conveniente poner una lista de las etiquetas permitidas. Algo que si que está en la FAQ, pero con la referencia CODE de VB. Ademas, antes de enviar la consulta, investigue si alguien habia hecho alguna referencia a errores de este tipo buscando hilos sobre DLL, pero en los que vi, no habia codigo que pudiese darme una pista para poner el mio bien formateado.

Gracias por la ayuda.

aggg63 · #6 04-09-2005

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
{ Private declarations }
public
{ Public declarations }
end;
var
Form1:TForm1;
implementation
uses
uTiposEGDB;
type
TFMensajes = procedure(texto: pAnsiChar); cdecl;
function IdentificarTablaFinales
(directory: pAnsiChar; var db_type: EGDB_TYPE; var max_pieces: Integer)
:integer; stdcall; external 'egdb.dll' name 'egdb_identify';
function AbrirTablaFinales
(bitmap_type: EGDB_BITMAP_TYPE; pieces,cache_mb: Integer;
directory: pAnsiChar; FMensajes: TFMensajes)
:PEGDB_DRIVER; cdecl; external 'egdb.dll' name 'egdb_open';
{$R *.dfm}
procedure FMensaje(texto: pAnsiChar); cdecl;
var
FicheroTexto: TextFile;
begin
AssignFile(FicheroTexto,'FicheroEGDB.txt');
Rewrite(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;
FMensajes: TFMensajes;
begin
directorio:='c:\damas\damas\egdb1\cake';
IdentificacionCorrecta:=IdentificarTablaFinales(directorio,TipoEGDB,piezas);
if IdentificacionCorrecta=0 then begin
memResultados.Lines.Add('Tipo EGDB: '+DescripcionTipoEGDB(TipoEGDB));
memResultados.Lines.Add('Piezas: '+inttostr(piezas));
end;
HandleEGDB:=AbrirTablaFinales(EGDB_NORMAL,piezas,300,directorio,FMensajes);
end;
end.

aggg63 · #7 04-09-2005

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
{ Private declarations }
public
{ Public declarations }
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;
{$R *.dfm}
procedure FMensaje(texto: pAnsiChar); cdecl;
var
FicheroTexto: TextFile;
begin
AssignFile(FicheroTexto,'FicheroEGDB.txt');
Rewrite(FicheroTexto);
Write(FicheroTexto,texto);
CloseFile(FicheroTexto);
end;
function CargarFuncionDLL(FicheroDLL: String; var HandleDLL: THandle;
Nombre: String; Indice: Integer=-1):Pointer;
begin
Result:=nil;
HandleDLL:=LoadLibrary(pAnsiChar(FicheroDLL));
If HandleDLL=0 then Exit;
If Indice<0 then
Result:=GetProcAddress(HandleDLL,pAnsiChar(Nombre))
else
Result:=GetProcAddress(HandleDLL,pAnsiChar(Indice));
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;
FMensajes: TFMensajes;
begin
IdentificarTablaFinales:=CargarFuncionDLL('egdb.dll',HandleDLL,'egdb_identify');
if assigned(IdentificarTablaFinales) then begin
directorio:='c:\damas\damas\egdb2\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;
AbrirTablaFinales:=CargarFuncionDLL('egdb.dll',HandleDLL,'egdb_open');
if assigned(AbrirTablaFinales) then
HandleEGDB:=AbrirTablaFinales(EGDB_NORMAL,piezas,30,directorio,FMensajes);
FreeLibrary(HandleDLL);
end;
end.

aggg63 · #8 04-09-2005

Código Delphi [-]unit uTiposEGDB;
interface

const
 // Color definitions
    EGDB_BLACK = 0;
    EGDB_WHITE = 1;
   // Values returned by handle->lookup()
    EGDB_UNKNOWN = 0; // value not in the database
    EGDB_WIN = 1; EGDB_LOSS = 2; EGDB_DRAW = 3;
    EGDB_NOT_IN_CACHE = 4; // conditional lookup and position not in cache
   // MTC macros
 MTC_THRESHOLD = 10;
    MTC_LESS_THAN_THRESHOLD = 1;
    MTC_UNKNOWN = 0;

type
 // Tipos de tablas de finales
 EGDB_TYPE = (
  EGDB_KINGSROW_WLD=0, EGDB_KINGSROW_MTC,
        EGDB_CAKE_WLD, EGDB_CHINOOK_WLD,
        EGDB_KINGSROW32_WLD, EGDB_KINGSROW32_MTC,
        EGDB_CHINOOK_ITALIAN_WLD,EGDB_KINGSROW32_ITALIAN_WLD,
        EGDB_KINGSROW32_ITALIAN_MTC);
 // for database lookup stats
 EGDB_STATS = record
     lru_cache_hits,lru_cache_loads,autoload_hits,
        db_requests,db_returns,db_not_present_requests: cardinal;
 end;
 EGDB_BITMAP_TYPE = (EGDB_NORMAL=0, EGDB_ROW_REVERSED);
 // This is KingsRow's definition of a checkers position.
 EGDB_NORMAL_BITMAP = record
     black,white,king: cardinal;
    end;
 // This is Cake's definition of a board position.
 EGDB_ROW_REVERSED_BITMAP = record
     black_man,black_king,white_man,white_king: cardinal;
    end;
    EGDB_BITMAP = record
     case integer of
         0: (normal: EGDB_NORMAL_BITMAP);
            1: (row_reversed: EGDB_ROW_REVERSED_BITMAP);
        end;
 PEGDB_BITMAP = ^EGDB_BITMAP;
    PEGDB_STATS = ^EGDB_STATS;
   // The driver handle type
   PEGDB_driver = ^TEGDB_driver;
    TEGDB_driver = record
     lookup: function (handle: PEGDB_driver; position: PEGDB_BITMAP;
                          color: integer; cl: integer): longint; cdecl; {stdcall;}
        reset_stats: procedure (handle: PEGDB_driver); cdecl;
        get_stats: function (handle: PEGDB_driver): PEGDB_STATS; cdecl;
        verify: function (handle: PEGDB_driver): integer; cdecl;
        close: function (handle: PEGDB_driver): integer; cdecl;
        internal_data: pointer;
    end;

implementation

end.

droguerman · #9 05-09-2005

bueno te aconsejo leer esta pagina con la cual aprendí sobre las DLL con ejemplo y todo, puede que por ahi te falte una @:http://www.delphi-central.com/dynamicdll.aspx

ahora con las DLL hay problemas que a veces son dificiles de entender hace poco hice una DLL que cargaba un TForm, cuando la llamaba desde mi aplicacion desde el explorer corria sin problemas, pero cuando otra q usaba winexec para llamar a mi aplicacion simplemente colgaba la maquina, asi que tuve q pasar a shellExecute, prueba con crearte una app pequeña y trata de ejecutar la llamada

aggg63 · #10 08-09-2005

Gracias droguerman por la sugerencia pero sigue sin funcionar. He recibido confirmacion del autor de la dll que todas las llamadas son cdecl y no stdcall. Sin embargo, he probado combinaciones y no funciona. Le he pedido que haga una dll sin la funcion que devuelve un menaje a ver si asi aislamos el problema. Estoy a la espera. De momento envio un fichero zip con 3 unidades que llaman a la dll de 3 maneras distintas, si alguien puede echarle un vistazo, estaria agradecido.

roman · #11 08-09-2005

Este hilo es muy largo y quizá me he saltado algo pero creo que hasta ahora no has mencionado cuál es el error que te dá excepto la mención original de "no me carga bien las funciones que exporta la DLL" pero supongo que sí las carga ya que verificas el resultado de GetProcAddress.

Además del convenio de llamada, ¿has revisado la forma en que declaras el encabezado?

Es decir, en

Código Delphi [-]AbrirTablaFinales: function(bitmap_type: EGDB_BITMAP_TYPE;
pieces,cache_mb: Integer;
directory: pAnsiChar;
FMensajes: TFMensajes)
:PEGDB_DRIVER; cdecl;

¿estás seguro que el último parámetro debe ser así? Según la declaración de TFMensajes:

Código Delphi [-]type
  TFMensajes = procedure(texto: pAnsiChar); cdecl;

infiero que el último parámetro es una función pero a juzgar por otras declaraciones en Delphi de la API de Windows, cuando un parámetro es una función, lo declaran como LongInt y luego hacen un moldeo para acceder a la función, es decir, que en ese tipo de parámetros reciben la dirección (LongInt) de la función.

Bueno, a lo mejor no tiene nada que ver pero igual te da una idea.

// Saludos

aggg63 · #12 08-09-2005

Hola.

El error que obtengo es:
"Access violation at address 00000000. Write of address 00000000" al ejecutar la linea:

Código:

HandleEGDB:=AbrirTablaFinalesEGDB_NORMAL,piezas,30,directorio,FMensajes);

Efectivamente, el ultimo parametro es una funcion a la que se le pasa un mensaje (pAnsiChar). Por lo que comentas y lo poco que se de Delphi avanzado, ¿estas sugiriendo que en vez de usar la funcion, use su direccion? Y ademas ¿moldeo=casting,typecast? ¿Y como llamo a una funcion sabiendo su direccion? ¿Podrias indicarme alguna API de ejemplo para echarle un vistazo?

Intentare hacer unas pruebas y averiguar algo mas.

Gracias por la sugerencia.

Cita:

Empezado por roman

Este hilo es muy largo y quizá me he saltado algo pero creo que hasta ahora no has mencionado cuál es el error que te dá excepto la mención original de "no me carga bien las funciones que exporta la DLL" pero supongo que sí las carga ya que verificas el resultado de GetProcAddress.

Además del convenio de llamada, ¿has revisado la forma en que declaras el encabezado?

Es decir, en

Código Delphi [-]AbrirTablaFinales: function(bitmap_type: EGDB_BITMAP_TYPE;
pieces,cache_mb: Integer;
directory: pAnsiChar;
FMensajes: TFMensajes)
:PEGDB_DRIVER; cdecl;

¿estás seguro que el último parámetro debe ser así? Según la declaración de TFMensajes:

Código Delphi [-]type
TFMensajes = procedure(texto: pAnsiChar); cdecl;

infiero que el último parámetro es una función pero a juzgar por otras declaraciones en Delphi de la API de Windows, cuando un parámetro es una función, lo declaran como LongInt y luego hacen un moldeo para acceder a la función, es decir, que en ese tipo de parámetros reciben la dirección (LongInt) de la función.

Bueno, a lo mejor no tiene nada que ver pero igual te da una idea.

// Saludos

roman · #13 08-09-2005

Dime una cosa; este parámetro del que hablamos, ¿es para recibir una función o para mandar una función? Es decir, ¿no será que egdb_open espera una función ya hecha? Porque de ser así, tendrías no sólo que declararla sino implementarla:

Código Delphi [-]procedure Mensajes(texto: pAnsiChar); cdecl;
begin
  bla, bla, bla
end;

y al llamar a egdb_open pasas @Mensajes (arroba incluida) como parámetro.

// Saludos