Acceso a DLL

[aggg63]

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.


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]

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]

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 (http://www.clubdelphi.com/foros/guiaestilo.php) de los Foros, fíjate en el apartado "Títulos descriptivos para los mensajes". Por otra parte sé bienvenido.

[droguerman]

intenta esto:

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]

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 (http://www.fierz.ch/checkers.htm) o en KingsRow (http://pages.prodigy.net/eyg/Checkers/KingsRow.htm).

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]

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]

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]

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.

[jmariano]

Saludos aggg63!

Te aconsejo identar un poco el código para que sea más legible y, sobretodo, que, en vez de crear varios hilos, comprimas las fuentes que quieres mostrar en un .zip y lo adjuntes al hilo, porque sino se hace muy dificil analizar tu problema. (Para poder adjuntar un archivo al hilo, pulsa sobre el boton "Responder" y busca en la parte inferior el bóton "Administrar Adjuntos", el cual te permitirá subir un archivo al foro).

Chao!

[droguerman]

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]

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]

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


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:


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]

Hola.

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


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.

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


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:


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]

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:



procedure Mensajes(texto: pAnsiChar); cdecl;
begin
bla, bla, bla
end;


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

// Saludos

[aggg63]

Hola.
La funcion esta implementada y ya probe tambien la opcion de pasar la direccion como @FMensaje, aunque en el codigo expuesto en un mensaje no aparezca. Da el mismo error.


procedure FMensaje(texto: pAnsiChar); cdecl;
var
FicheroTexto: TextFile;
begin
AssignFile(FicheroTexto,'FicheroEGDB.txt');
Rewrite(FicheroTexto);
Write(FicheroTexto,texto);
CloseFile(FicheroTexto);
end;

[roman]

Da el mismo error

Sí, pero ¿cambiaste la declaración de egdb_open para que el último parámetro sea LongInt?

// Saludos

[aggg63]

Supongo que te refieres a que cambie la definicion de la funcion


AbrirTablaFinales:function(bitmap_type: EGDB_BITMAP_TYPE;
pieces,cache_mb: Integer;
directory: pAnsiChar;
FMensajes: TFMensajes)
:PEGDB_DRIVER; cdecl;


por


AbrirTablaFinales:function(bitmap_type: EGDB_BITMAP_TYPE;
pieces,cache_mb: Integer;
directory: pAnsiChar;
direccion: longint):
PEGDB_DRIVER; cdecl;


Pues si, he cambiado la definicion y he probado los tipos integer, longint, longword y cardinal. Tambien he probado a poner un tipo pointer. En este caso me da unas direcciones de memoria diferentes en el error: "Access violation at address 100052D2 in module 'egdb.dll'. Write of address 00019DF0".


Gracias por la ayuda.

[aggg63]

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.


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;
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; // SOLUCION DEL PROBLEMA
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
//FreeLibrary(HandleDLL);
end.

[bohemio87x]

hola viejo, a estas alturas que vengo a dar con este tema, supongo que solucionaste el problema y terminaste de desarrolar el motor de damas españolas que empezaste, sabes, tengo tiempo buscando un motor que juege la variante española de damas y hasta aqui no lo eh conseguido, quisiera tu ayuda. Ojala pudieras poporcionarme ese motro o darme el link de donde pueda descargar uno...

[Casimiro Notevi]

Bienvenido a clubdelphi, ¿ya leiste nuestra guía de estilo (http://www.clubdelphi.com/foros/guiaestilo.php)?, gracias por tu colaboración :)