2005. július 10., vasárnap

Use forms declared in DLL by an executable


Problem/Question/Abstract:

How to use forms declared in DLL by an executable?

Answer:

In the example that follows the exe only sees a totally "virtual abstract" interface to the object as is being exported from the dll but it still can create the object and use it. Of course the exe can not see or execute any methods declared in the exe but that is the whole purpose of implementing them in a custom dll to begin with.

// Example code:

program Dlloader;

uses
  Sharemem,
  Forms,
  exeunit1 in 'exeunit1.pas' {Form1},
  DllIntfu in 'DllIntfu.pas';

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

//--------------------------

unit DllIntfu;

interface

type
  TDllobject = class
  protected
    function Get_UserName: string; virtual; abstract;
    procedure Set_UserName(Value: string); virtual; abstract;
  public
    property UserName: string read Get_UserName write Set_UserName;
  end;
  TDllobjectClass = class of TDllobject;

implementation

end.

//---------------------------

unit exeunit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics,
  Controls, Forms, Dialogs, DllIntfu, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

type
  TDllfunc = function: TDllobjectClass;
  stdcall;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: DWORD;
  fHandle: THandle;
  fDllfunc: TDllfunc;
  fDllobject: TDllobject;
  fUserName: string;
begin
  fHandle := LoadLibrary('UserName.dll');
  if (fHandle <> 0) then
  begin
    @fDllfunc := GetProcAddress(fHandle, 'Dllfunc');
    if Assigned(@fDllfunc) then
    begin
      i := 255;
      SetLength(fUserName, i);
      GetUserName(PChar(fUserName), i);
      fUserName := StrPas(PChar(fUserName));
      fDllobject := fDllfunc.Create;
      fDllobject.UserName := fUserName;
      ShowMessage(fDllobject.UserName);
      fDllobject.Free;
    end;
    FreeLibrary(fHandle);
  end;
end;

end.

//-------------------------------

library UserName;

uses
  Sharemem,
  Sysutils,
  DllIntfu;

type
  TCustomDllobject = class(TDllobject)
  private
    fUserName: string;
    function Getfilecount: Integer;
  protected
    function Get_UserName: string; override;
    procedure Set_UserName(Value: string); override;
  end;

  TCustomDllobjectclass = class of TCustomDllobject;

function TCustomDllobject.Getfilecount: Integer;
var
  doserr: Integer;
  fsrch: TSearchRec;
begin
  Result := 0;
  doserr := FindFirst('*.*', faanyfile, fsrch);
  if (doserr = 0) then
  begin
    while (doserr = 0) do
    begin
      if (fsrch.attr and faDirectory) = 0 then
        Inc(Result);
      doserr := findnext(fsrch);
    end;
    FindClose(fsrch);
  end;
end;

function TCustomDllobject.Get_UserName: string;
begin
  Result := 'You signed on as ''' + fUserName + '''' +
    ' and there ' + IntToStr(Getfilecount) +
    ' files in this directory.';
end;

procedure TCustomDllobject.Set_UserName(Value: string);
begin
  fUserName := Value;
end;

function Dllfunc: TCustomDllobjectClass; stdcall;
begin
  Result := TCustomDllobject; // class type only
end;

exports
  Dllfunc name 'Dllfunc';

begin
end.

Nincsenek megjegyzések:

Megjegyzés küldése