was ist neu ¦  programmier tips ¦  indy artikel ¦  intraweb artikel ¦  informationen ¦  links ¦  interviews
 sonstiges ¦  tutorials ¦  Add&Win Gewinnspiel

Tips (1541)

Dateien (137)
Datenbanken (90)
Drucken (35)
Grafik (114)
IDE (21)
Indy (5)
Internet / LAN (130)
IntraWeb (0)
Mathematik (76)
Multimedia (45)
Oberfläche (107)
Objekte/
ActiveX (51)

OpenTools API (3)
Sonstiges (126)
Strings (83)
System (266)
VCL (242)

Tips sortiert nach
Komponente


Tip suchen

Tip hinzufügen

Add&Win Gewinnspiel

Werbung

52 Visitors Online


 
...Forms aus einer DLL verwenden?
Autor: Dennis Passmore
[ Tip ausdrucken ]  

Tip Bewertung (7):  
     


{
  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.

  Im folgenden Beispiel sieht die Exe-Datei nur ein total "virtuelles, abstraktes"
  Interface zum Objekt, welches aus der Dll importiert wird aber es
  kann doch dieses Objekt erzeugen und es gebrauchen.
}


// 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: stringvirtualabstract;
    procedure Set_UserName(Value: string); virtualabstract;
  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: stringoverride;
    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
.


 

Bewerten Sie diesen Tipp:

dürftig
ausgezeichnet


Copyright © by SwissDelphiCenter.ch
All trademarks are the sole property of their respective owners