Acceso a DLL

[aggg63]

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]

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.

[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!