| __cadetill |
05-01-2004 18:46:19 |
Acabo de hacerle una demo a un compañero del Club. ´La demo se la he hecho con paso de usuario/contraseña o pasando los componentes de conexión. He aquí el código
Exe llamador (contiene 2 botones para las dos llamadas a las 2 funciones de la dll)
Código:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, IBCustomDataSet, IBTable, IBDatabase;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
IBDatabase1: TIBDatabase;
IBTransaction1: TIBTransaction;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
user, pass, BD : string;
public
{ Public declarations }
end;
const
DLL_PRUEBA = 'Project2.dll';
var
Form1: TForm1;
PasandoComponentes : function( hWnd: THandle;
IBDatabase1: TIBDatabase; IBTransaction1: TIBTransaction ) :
integer; stdcall;
PasandoUserPass : function( hWnd: THandle; User, Pass, BD: string ) :
integer; stdcall;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
Handle: THandle;
begin
Handle := LoadLibrary(DLL_PRUEBA);
if Handle <> 0 then
begin
@PasandoComponentes := GetProcAddress(Handle, 'PasandoComponentes');
try
if @PasandoComponentes <> nil then
begin
PasandoComponentes( Self.Handle, IBDatabase1, IBTransaction1 );
end;
finally
FreeLibrary(Handle);
end;
end; // Fin del IF del Han
end;
procedure TForm1.Button2Click(Sender: TObject);
var
Handle: THandle;
begin
Handle := LoadLibrary(DLL_PRUEBA);
if Handle <> 0 then
begin
@PasandoUserPass := GetProcAddress(Handle, 'PasandoUserPass');
try
if @PasandoUserPass <> nil then
begin
BD := IBDatabase1.DatabaseName;
user := 'SYSDBA';
pass := 'masterkey';
PasandoUserPass( Self.Handle, User, Pass, BD );
end;
finally
FreeLibrary(Handle);
end;
end; // Fin del IF del Han
end;
end.
Código de la Dll (tiene dos formularios de los que no pondré el código porque creo que es bastante opbio, aunque si lo necesitas, tambien te lo pongo)
Código:
library Project2;
uses
SysUtils,
Classes,
Forms,
Dialogs,
IBDatabase,
Unit2 in 'Unit2.pas' {Form2},
Unit3 in 'Unit3.pas' {Form3};
{$R *.res}
function PasandoUserPass( hWnd : THandle; User, Pass,
BD : string ) : integer; stdcall; export;
var
iValRet: Integer;
begin
Application.Handle := hWnd;
try
Form2 := TForm2.Create(Application);
try
Form2.user := User;
Form2.pass := Pass;
Form2.bd := BD;
iValRet := Form2.ShowModal;
finally
FreeAndNil(Form2);
end;
except
on E: Exception do
begin
ShowMessage('Error Creant Formulari. ' + E.Message);
raise;
end;
end;
Result := iValRet;
end;
function PasandoComponentes( hWnd: THandle;
IBDatabase1: TIBDatabase; IBTransaction1: TIBTransaction ) : integer;
stdcall; export;
var
iValRet: Integer;
begin
Application.Handle := hWnd;
try
Form3 := TForm3.Create(Application);
try
Form3.IBDatabase1 := IBDatabase1;
Form3.IBTransaction1 := IBTransaction1;
iValRet := Form3.ShowModal;
finally
FreeAndNil(Form3);
end;
except
on E: Exception do
begin
ShowMessage('Error Creant Formulari. ' + E.Message);
raise;
end;
end;
Result := iValRet;
end;
exports
PasandoUserPass,
PasandoComponentes;
begin
end.
Pues nada, espero te sea de utilidad |
