Übergabe einer Klasse von EXE an DLL

[DeddyH]

OK, mal schnell heruntergeschludert (kann also noch Denkfehler enthalten, funktionierte aber bei einem schnellen Test): zunächst ein Interface mit einer Property nebst Getter und Setter und einer Methode.

Delphi-Quellcode:

unit TestIntf;

interface

uses System.Classes;

type
  ITestIntf = interface
    ['{AE7A35E3-5DB3-4DEB-A817-E452DD62301C}']
    function GetItems: TStrings; stdcall;
    procedure SetItems(const Value: TStrings); stdcall;
    procedure ShowContents; stdcall;
    property Items: TStrings read GetItems write SetItems;
  end;

implementation

end.

Dieses Interface wird sowohl in der DLL als in der Exe benutzt. Jetzt zur DLL, Klassenunit:

Delphi-Quellcode:

unit DLLClass;

interface

uses TestIntf, System.Classes;

type
  TTest = class(TInterfacedObject, ITestIntf)
  strict private
    FItems: TStrings;
  public
    function GetItems: TStrings; stdcall;
    procedure SetItems(const Value: TStrings); stdcall;
    procedure ShowContents; stdcall;
    property Items: TStrings read GetItems write SetItems;
  end;

function GetTest: ITestIntf; stdcall;

implementation

uses Vcl.Dialogs;

function GetTest: ITestIntf; stdcall;
begin
  Result := TTest.Create;
end;

{ TTest }

function TTest.GetItems: TStrings;
begin
  Result := FItems;
end;

procedure TTest.SetItems(const Value: TStrings);
begin
  FItems := Value;
end;

procedure TTest.ShowContents;
var
  s: string;
begin
  if Assigned(FItems) then
    s := FItems.Text
  else
    s := '< Keine Items zugewiesen >';
  ShowMessage(s);
end;

end.

Das ist also eine minimale Klasse, die das Interface imlementiert. Zu beachten ist auch die Funktion GetTest, diese wird in der Hauptunit der DLL exportiert.

Delphi-Quellcode:

library IntfDLL;

uses
  DLLClass in 'DLLClass.pas';

{R *.res}

exports
  GetTest;

begin
end.

In der Exe habe ich dann diese DLL einfach statisch gebunden:

Delphi-Quellcode:

unit ExeMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, TestIntf, Vcl.StdCtrls;

type
  TfrmDLLTestMain = class(TForm)
    btnCallIntf: TButton;
    procedure btnCallIntfClick(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  frmDLLTestMain: TfrmDLLTestMain;

implementation

{$R *.dfm}

function GetTest: ITestIntf; stdcall; external 'IntfDLL.dll' name 'GetTest';

procedure TfrmDLLTestMain.btnCallIntfClick(Sender: TObject);
var
  List: TStringList;
  Test: ITestIntf;
begin
  Test := GetTest;
  List := TStringList.Create;
  try
    List.Add('Das');
    List.Add('ist');
    List.Add('das');
    List.Add('Haus');
    List.Add('vom');
    List.Add('Nikolaus');
    // Einmal vor der Zuweisung
    Test.ShowContents;
    Test.Items := List;
    // Und einmal nachher
    Test.ShowContents;
  finally
    List.Free;
  end;
end;

end.

Und nur der Vollständigkeit halber noch die *.dpr, da steht auch keine Magic drin:

Delphi-Quellcode:

program IntfTest;

uses
  Vcl.Forms,
  ExeMain in 'ExeMain.pas' {frmDLLTestMain};

{$R *.res}

begin
  ReportMemoryLeaksOnShutdown := true;
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TfrmDLLTestMain, frmDLLTestMain);
  Application.Run;
end.

[norwegen60]

Zitat von DeddyH:

OK, mal schnell heruntergeschludert (kann also noch Denkfehler enthalten, funktionierte aber bei einem schnellen Test)

Danke. Damit ist das Wochenende gerettet. Jetzt habe ich endlich was zu tun
Mal schauen, was das für unsere Struktur bedeutet

[Fritzew]

Zitat von DeddyH:

OK, mal schnell heruntergeschludert (kann also noch Denkfehler enthalten, funktionierte aber bei einem schnellen Test): zunächst ein Interface mit einer Property nebst Getter und Setter und einer Methode.

Delphi-Quellcode:

unit TestIntf;

interface

uses System.Classes;

type
  ITestIntf = interface
    ['{AE7A35E3-5DB3-4DEB-A817-E452DD62301C}']
    function GetItems: TStrings; stdcall;
    procedure SetItems(const Value: TStrings); stdcall;
    procedure ShowContents; stdcall;
    property Items: TStrings read GetItems write SetItems; // Meiner Meinung nach böse eine Klasse zu übergeben wenn auch abstract
  end;

implementation

end.

Einspruch!!
Das ist kein gutes Design. Du mixt hier Interfaces und Implementation

Durch
 property Items: TStrings read GetItems write SetItems; bist Du an einen Compiler gebunden.
Ein Interface sollte nur solche benutzen.

Delphi-Quellcode:

unit myInterfaces;

interface
   uses System.Classes;

type
  // Wenn wir nur über Window sprechen ist Dies ein Ansatz:
  IStringList = interface
     ['{143A95EE-EEEA-4F7F-97CC-7986EBAC17A5}']
     function AddString(const Value: WideString): Integer; stdcall;
     function GetCount: Integer; stdcall;
     function GetItems(Index: Integer): WideString; stdcall;
     procedure SetItems(Index: Integer; const Value: WideString); stdcall;
     property Count: Integer read GetCount;
     property Items[Index: Integer]: WideString read GetItems write SetItems;
  end;

   // Für non Windows müssen wir auf PlainData ztrückgreifen
   ICharBufferInterface = interface
    ['{D6CAF8DE-7792-4162-B472-E9F0A2410201}']
    procedure SetBuffer(const Buffer: PWideChar; Len : integer); stdcall;
    procedure GetBuffer(const Buffer: PWideChar; Len : integer); stdcall;
    function BufferLen : integer;
  end;

  IBufferList = interface
     ['{6FCA6674-3BE2-4D02-A078-F3142B1A41C1}']
     function GetCount: Integer; stdcall;
     function GetItems(Index: Integer): ICharBufferInterface; stdcall;
     procedure SetItems(Index: Integer; Value: ICharBufferInterface); stdcall;
     property Count: Integer read GetCount;
     property Items[Index: Integer]: ICharBufferInterface read GetItems write SetItems;
     function AddItem: ICharBufferInterface; stdcall;
  end;

implementation

end.

Hier noch eine mögliche implementierung einer Klasse dazu:

Delphi-Quellcode:

unit myImplementation;

interface
    uses System.Classes,
         myInterfaces;


 type TMyWideStringListImpl = class(TInterfaceList, IStringList)

 private
    fList : TStringList;
    function checkIndex(index : integer) : boolean; inline;

  private    // From IStringList
    function AddString(const Value: WideString): Integer; stdcall;
    function GetCount: Integer; stdcall;
    function GetItems(Index: Integer): WideString; stdcall;
    procedure SetItems(Index: Integer; const Value: WideString); stdcall;

  public
    constructor Create;
    destructor Destroy; override;
 end;

implementation

function TMyWideStringListImpl.AddString(const Value: WideString): Integer;
begin
   result := flist.Add(Value);
end;

function TMyWideStringListImpl.GetCount: Integer;
begin
   result := fList.Count;
end;

function TMyWideStringListImpl.GetItems(Index: Integer): WideString;
begin
 if checkindex(index) then
  result := Flist[Index]
  else result := '';
end;


procedure TMyWideStringListImpl.SetItems(Index: Integer; const Value: WideString);
begin
   Flist[Index] := Value;
end;

constructor TMyWideStringListImpl.Create;
begin
  inherited;
  fList := TStringList.create;
end;

destructor TMyWideStringListImpl.Destroy;
begin
  fList.free;

  inherited;
end;

function TMyWideStringListImpl.checkIndex(index: integer): boolean;
begin
   result := (index >= 0) and (index<Flist.count);
end;

end.

[Fritzew]

Ich habe mir mal die Zeit genommen das so aufzubereiten wie ich es für richtig halte.
es geht mir darum zu zeigen wie die Interfaces meiner Meinung nach aussehen sollten.

Zur vereinfachung habe ich mal 2 Deiner Klassen als Basis genommen.
Die Klasse Tmesswert habe ich um einen Info String erweitert.


Mit diesem Ansatz sind im NormalFall so gut wie keine Änderungen in Deinen konkreten Klassen notwendig
und sind komplett Compilerunabhängig. Die Dll kann also auch mit einem anderen Compiler erstellt werden
ohne das Probleme zu erwarten sind.

Delphi-Quellcode:

unit Analyse.Defaults;

interface
  uses classes, Generics.collections;
 // Hier nur zur verdeutlichung
 type
  TMesswert = class(TObject)
    Belastung : Real;
    Strom : Real;
    Info : String;
  end;

  TMesswertListe = class( TObjectList<TMesswert> )
  end;

implementation
end.

Als nächstes die Interfaces dazu:

Delphi-Quellcode:

unit Analyse.Interfaces;
interface
 type
    IMesswert = interface
   ['{CAD5EAF6-D0DE-4C2A-A955-EEDE805B09F4}']
      function GetBelastung: Double; stdcall;
      function GetInfo: WideString; stdcall;
      function GetStrom: Double; stdcall;
      procedure SetBelastung(const Value: Double); stdcall;
      procedure SetInfo(const Value: WideString); stdcall;
      procedure SetStrom(const Value: Double); stdcall;
      property Belastung: Double read GetBelastung write SetBelastung;
      property Info: WideString read GetInfo write SetInfo;   // WideString wird verwendet weil da Windows das Speicherhandling übernimmt
      property Strom: Double read GetStrom write SetStrom;

   end;

  // Hier kommt alles rein was der Konsument können muss
   IMesswertList = interface
      ['{A8F39543-4F57-49EB-99B8-78DD4DBCA4B9}']
      // Wir wollen wissen wieviele Einträge es gibt...
      function GetCount: Integer; stdcall;
      // Nur LeseZugriff auf die Items
      function GetItem( index : Integer) : IMesswert; stdcall;
      // Abfragen eines Index
      function GetItemIndex(item : IMesswert) : integer;  stdcall;
      // Neuen Eintrag anhängen
      function AddItem : IMesswert; stdcall;
   end;
implementation
end.

Hier die Implementierung

Delphi-Quellcode:

unit Analyse.Implementations;

interface
uses
   System.sysutils,
   System.classes,
   Analyse.Interfaces,
   Analyse.Defaults;

// Hier definieren wir 2 Wrapper Kalssen für die Interfaces

type
  TIMesswert = class(TInterfacedObject, IMesswert)
   private
    FMesswert : TMesswert;
    function GetBelastung: Double; stdcall;
    function GetInfo: WideString; stdcall;
    function GetStrom: Double; stdcall;
    procedure SetBelastung(const Value: Double); stdcall;
    procedure SetInfo(const Value: WideString); stdcall;
    procedure SetStrom(const Value: Double); stdcall;
   protected
     function getMesswert : TMesswert;
   public
    constructor Create(aMesswert : TMesswert);
    destructor Destroy; override;
  end;


  TIMesswertListWrapper = class(TInterfacedObject, IMesswertList)
   private
     Flist : TMesswertListe;
     function AddItem: IMesswert; stdcall;
     function GetCount: Integer; stdcall;
     function GetItem(index : Integer): IMesswert; stdcall;
     function GetItemIndex( item : IMesswert): integer; stdcall;
   public
    constructor Create(const aList : TMesswertListe );
    destructor Destroy; override;
  end;

implementation

function TIMesswert.GetBelastung: Double;
begin
   Result := FMesswert.Belastung;
end;

function TIMesswert.GetStrom: Double;
begin
   Result := FMesswert.Strom;
end;

procedure TIMesswert.SetBelastung(const Value: Double);
begin
   Fmesswert.Belastung := Value;
end;

procedure TIMesswert.SetStrom(const Value: Double);
begin
   FMesswert.Strom := Value;
end;

function TIMesswert.getMesswert: TMesswert;
begin
  result := FMesswert;
end;

constructor TIMesswert.Create(aMesswert: TMesswert);
begin
  inherited create;
  FMesswert := aMesswert;
end;

destructor TIMesswert.Destroy;
begin
  FMesswert := nil;
  inherited;
end;

function TIMesswert.GetInfo: WideString;
begin
  result := FMesswert.Info;
end;

procedure TIMesswert.SetInfo(const Value: WideString);
begin
  FMesswert.Info := Value;
end;

{ TIMesswertListWrapper }

constructor TIMesswertListWrapper.Create(const aList: TMesswertListe);
begin
  inherited Create;
  Assert(Flist = nil,'Liste muss übergeben werden');
  Flist := aList;
end;

destructor TIMesswertListWrapper.Destroy;
begin
  flist := nil;
  inherited;
end;

function TIMesswertListWrapper.AddItem: IMesswert;
var lMesswert : TMesswert;
begin
  lMesswert := TMesswert.create;
  Flist.add(lMesswert);
  result := TIMesswert.Create(lMesswert);
end;

function TIMesswertListWrapper.GetCount: Integer;
begin
  result := Flist.count;
end;

function TIMesswertListWrapper.GetItem(index : Integer): IMesswert;
begin
   // TODO -cMM: index prüfen
   result :=  TIMesswert.Create(flist[index]);
end;

function TIMesswertListWrapper.GetItemIndex(item : IMesswert): integer;
begin
// TODO -cMM: Gültigkeit von item prüfen
   result := Flist.IndexOf((item as TIMesswert).getmesswert);
end;

end.

Und nun zur Benutzung

Delphi-Quellcode:

unit Analyse.Worker;

interface

uses
  Analyse.Defaults;
  type
    tAnalyseWork = class
       public
         class function doAnalyse(aList : TMesswertListe) : boolean;
    end;

implementation

uses
  Analyse.Interfaces,
  Analyse.Implementations;

 // Nur als  Dummy hier
  function DllFunc(List : IMesswertList) : boolean; stdcall; // external whatever
  begin
     result := false;
  end;

{ tAnalyseWork }
class function tAnalyseWork.doAnalyse(aList: TMesswertListe): boolean;
var lWorker : TIMesswertListWrapper;
begin
  lworker := TIMesswertListWrapper.Create(Alist);
  try
      // Aufruf der Dll
     result := Dllfunc(lworker);
  finally
     lworker := nil;
  end;
end;
end.

[stahli]

@norwegen60

Interfaces sind kein Hexenwerk.
Wenn Du etwas Zeit dafür hast dann schau sie Dir mal an.
Vielleicht hilft Dir das etwas:
http://www.delphipraxis.net/192364-t...nterfaces.html
http://www.delphipraxis.net/183702-i...-factorys.html

[jus]

Zitat von DeddyH:

OK, mal schnell heruntergeschludert (kann also noch Denkfehler enthalten, funktionierte aber bei einem schnellen Test): zunächst ein Interface mit einer Property nebst Getter und Setter und einer Methode.

...

Zitat von Fritzew:

Ich habe mir mal die Zeit genommen das so aufzubereiten wie ich es für richtig halte.
es geht mir darum zu zeigen wie die Interfaces meiner Meinung nach aussehen sollten.

Zur vereinfachung habe ich mal 2 Deiner Klassen als Basis genommen.
Die Klasse Tmesswert habe ich um einen Info String erweitert.


Mit diesem Ansatz sind im NormalFall so gut wie keine Änderungen in Deinen konkreten Klassen notwendig
und sind komplett Compilerunabhängig. Die Dll kann also auch mit einem anderen Compiler erstellt werden
ohne das Probleme zu erwarten sind.

...

Ahh... habe erst jetzt die Lösungen entdeckt , vielen vielen Dank an Fritznew and DeddyH für den Code!!!!

lg,
jus