Ver Mensaje Individual
  #5  
Antiguo 05-01-2004
__cadetill __cadetill is offline
Miembro
 
Registrado: may 2003
Posts: 3.387
Reputación: 25
__cadetill Va por buen camino
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
Responder Con Cita