Aloha,
wie in
diesem Thread erläutert, habe ich mir ein wenig Code zusammengebastelt, um dynamisch DLLs als Plugin in mein Hauptprogramm einbinden zu können.
Das funktioniert soweit auch ganz gut, wenn ich allerdings die Function GetName():string; der
DLL im Hauptprogramm aufrufe, wird zwar der Wert zurückgeliefert und auch ausgegeben (-> showmessage), allerdings erhalte ich danach eine
Exception "Ungültige Zeigeroperation".
Die Procedure Execute(); funktioniert allerdings problemlos... wohl weil sie nichts zurückliefert?
Plugin
Delphi-Quellcode:
library PlugIn;
uses
SysUtils,
Classes,
Windows,
uPlugInDefinition in '..\shared\uPlugInDefinition.pas';
{$R *.res}
type
TPlugIn = class(TInterfacedObject, IPlugIn)
function getName : string; stdcall;
procedure Execute; stdcall;
end;
{ TPlugIn }
procedure TPlugIn.Execute;
begin
MessageBox(0, 'Test!', 'Blubb', 0);
end;
function TPlugIn.getName : string;
begin
Result := 'Beispiel...';
end;
{ einzige exportierte Funktion }
function InitPlugin: IPlugin; stdcall; {export;}
begin
Result := TPlugIn.Create;
end;
exports
InitPlugin;
end.
uPlugInDefinition.pas
Delphi-Quellcode:
unit uPlugInDefinition;
interface
uses
Windows;
type
IPlugIn =
interface
['
{8E5F6F87-BD7C-4F51-A2B2-36E437E20648}']
function getName :
string;
stdcall;
procedure Execute;
stdcall;
end;
implementation
{ TPlugIn }
end.
Hauptprogramm
Delphi-Quellcode:
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, uPlugInDefinition, ExtCtrls, GR32;
type
TForm1 =
class(TForm)
//[...]
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
plugins : TInterfaceList;
procedure LoadPlugin(DLLName:
string);
procedure LoadPlugIns;
procedure UnloadPlugIns;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
plugins := TInterfaceList.Create;
LoadPlugIns;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
UnloadPlugIns;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if plugins.Count > 0
then
begin
// funktioniert
IPlugIn(plugins.Items[0]).execute;
// funktioniert, aber danach Exception
showmessage(IPlugIn(plugins.Items[0]).getName);
end;
end;
procedure TForm1.LoadPlugin(DLLName:
string);
type
TProcInitPlg =
function: IPlugin;
stdcall;
var
fName:
string;
aProc: TProcInitPlg;
hDLL: HWND;
fProc: TFarProc;
begin
fname := dllname;
hDll := LoadLibrary(@fName[1]);
fProc := GetProcAddress(hDLL,'
InitPlugin');
if fProc <>
nil then begin
@aProc := fProc;
end else Exit;
plugins.Add(aProc);
end;
procedure TForm1.LoadPlugIns;
// [...]
// --> LoadPlugin('test.dll');
procedure TForm1.UnloadPlugIns;
var
I: Integer;
begin
for I := 0
to plugins.Count-1
do
begin
try
plugins.Items[i]._Release;
except
end;
end;
plugins.clear;
end;
end.
Wieso funktioniert das getName nicht oder was kann ich tun, damit es funktioniert? :S
Liebe Grüße und vielen Dank
Flo