Zugriff auf lokale Variablen bei Callback aus DLL

[kaju74]

Hallo.

Der Zugriff auch Strings ist kein Problem...das wird alles übergeben, egal wie lang. Habe statt "SimpleShareMem" auch schon mit FastMM4 und diversen Optionen rumexperimentiert, ohne Erfolg.

Das PlugIn selber hält eine Liste der registrierten Callbacks. Hier mal der komplette Code:

Delphi-Quellcode:

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, xpCore, xpPlugInMng;

type
{ TfrmMain }

  TfrmMain = class(TForm)
    btnTest: TButton;
    edtFirstName: TLabeledEdit;
    edtLastName: TLabeledEdit;
    mmoLog: TMemo;
    PlugInManager: TxpPlugInManager;
    procedure FormCreate(Sender: TObject);
    procedure PlugInManagerLoadPlugIn(Sender: TObject; PlugIn: TxpPlugIn);
    procedure PlugInManagerUnloadPlugIn(Sender: TObject; PlugIn: TxpPlugIn);
    procedure btnTestClick(Sender: TObject);
  private
    { Private-Deklarationen }
    FLocalVar: string;
    procedure CallbackProc(ActionGUID: string; CallbackInfo: Pointer);
  public
    { Public-Deklarationen }
  end;

var
  frmMain: TfrmMain;

implementation

uses
  SamplePlugInIntf;

{$R *.dfm}

{-------------------------------------------------------------------------------
  Procedure: TfrmMain.FormCreate
  Author:    Marc Hoffmann
  DateTime:  2009/12/10
  Arguments: Sender: TObject
  Result:    None
-------------------------------------------------------------------------------}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FLocalVar := 'In der Wüste steht ein Reddisch - ferdisch 8-)';
end;

{-------------------------------------------------------------------------------
  Procedure: TfrmMain.PlugInManagerLoadPlugIn
  Author:    Marc Hoffmann
  DateTime:  2009/12/10
  Arguments: Sender: TObject; PlugIn: TxpPlugIn
  Result:    None
-------------------------------------------------------------------------------}

procedure TfrmMain.PlugInManagerLoadPlugIn(Sender: TObject; PlugIn: TxpPlugIn);
begin
  mmoLog.Lines.Add(Format('PlugIn "%s" geladen...', [PlugIn.FileName]));
end;

{-------------------------------------------------------------------------------
  Procedure: TfrmMain.PlugInManagerUnloadPlugIn
  Author:    Marc Hoffmann
  DateTime:  2009/12/10
  Arguments: Sender: TObject; PlugIn: TxpPlugIn
  Result:    None
-------------------------------------------------------------------------------}

procedure TfrmMain.PlugInManagerUnloadPlugIn(Sender: TObject; PlugIn: TxpPlugIn);
begin
  mmoLog.Lines.Add(Format('PlugIn "%s" entladen...', [PlugIn.FileName]));
end;

{-------------------------------------------------------------------------------
  Procedure: TfrmMain.CallbackProc
  Author:    Marc Hoffmann
  DateTime:  2009/12/10
  Arguments: ActionGUID: string; CallbackInfo: Pointer
  Result:    None
-------------------------------------------------------------------------------}

procedure TfrmMain.CallbackProc(ActionGUID: string; CallbackInfo: Pointer);
var
  CallbackStruct: PCallbackStruct;
begin
  ShowMessage('B: ' + Self.FLocalVar);
  CallbackStruct := CallbackInfo;
  ShowMessage('Callback called:' + #13#13 + Trim(CallbackStruct^.FirstName + #32 + CallbackStruct^.LastName));
end;

{-------------------------------------------------------------------------------
  Procedure: TfrmMain.btnTestClick
  Author:    Marc Hoffmann
  DateTime:  2009/12/10
  Arguments: Sender: TObject
  Result:    None
-------------------------------------------------------------------------------}

procedure TfrmMain.btnTestClick(Sender: TObject);
var
  SamplePlugIn: ISamplePlugIn;
begin
  ShowMessage('A: ' + FLocalVar);
  if not(PlugInManager.LoadPlugIn('SamplePlugIn', ISamplePlugIn, SamplePlugIn)) then
    raise Exception.Create(PlugInManager.LastError);
  try
    SamplePlugIn.RegisterCallbackProc(CallbackProc);
    SamplePlugIn.Execute(edtLastName.Text, edtFirstName.Text);
  finally
    PlugInManager.UnloadPlugIn(SamplePlugIn);
  end;
end;

end.

Und hier die relevanten PlugIn-Stellen:

Delphi-Quellcode:

unit SamplePlugInIntf;

interface

uses
  xpPlugInIntf;

type

{ TCallbackStruct }

  TCallbackStruct = record
    LastName: string;
    FirstName: string;
  end;
  PCallbackStruct = ^TCallbackStruct;

{ ISamplePlugIn }

  ISamplePlugIn = interface(IxpCustomPlugIn)
  ['{75C9A79A-DD40-4823-B7FC-17DB187B4526}']
    function RegisterCallbackProc(CallbackProc: TxpPlugInCallbackProc): Boolean;
    function FindCallbackProc: TxpPlugInCallbackProc;
    procedure Execute(const LastName, FirstName: string);
  end;

implementation

end.

UND:

Delphi-Quellcode:

unit SamplePlugInImpl;

interface

uses
  Classes, xpPlugInIntf, xpPlugInImpl, SamplePlugInIntf;

type
{ TCallbackProcStruct }

  TCallbackProcStruct = record
    CallbackProc: Pointer;
  end;
  PCallbackProcStruct = ^TCallbackProcStruct;


{ TSamplePlugIn }

  TSamplePlugIn = class(TxpCustomPlugIn, ISamplePlugIn)
  private
    { Private-Deklarationen }
    FCallbackProcs: TList;
  public
    { Public-Deklarationen }
    constructor Create;
    destructor Destroy; override;
    function RegisterCallbackProc(CallbackProc: TxpPlugInCallbackProc): Boolean;
    function FindCallbackProc: TxpPlugInCallbackProc;
    procedure Execute(const LastName, FirstName: string);
  end;

implementation

{ TSamplePlugIn }

{-------------------------------------------------------------------------------
  Procedure: TSamplePlugIn.Create
  Author:    Marc Hoffmann
  DateTime:  2009/12/10
  Arguments: None
  Result:    None
-------------------------------------------------------------------------------}

constructor TSamplePlugIn.Create;
begin
  inherited Create;
  FCallbackProcs := TList.Create;
end;

{-------------------------------------------------------------------------------
  Procedure: TSamplePlugIn.Destroy
  Author:    Marc Hoffmann
  DateTime:  2009/12/10
  Arguments: None
  Result:    None
-------------------------------------------------------------------------------}

destructor TSamplePlugIn.Destroy;
begin
  FCallbackProcs.Free;
  inherited;
end;

{-------------------------------------------------------------------------------
  Procedure: TSamplePlugIn.RegisterCallbackProc
  Author:    Marc Hoffmann
  DateTime:  2009/12/10
  Arguments: CallbackProc: TxpPlugInCallbackProc
  Result:    Boolean
-------------------------------------------------------------------------------}

function TSamplePlugIn.RegisterCallbackProc(CallbackProc: TxpPlugInCallbackProc): Boolean;
var
  CallbackProcStruct: PCallbackProcStruct;
begin
  try
    New(CallbackProcStruct);
    CallbackProcStruct^.CallbackProc := @CallbackProc;
    FCallbackProcs.Add(CallbackProcStruct);
    Result := True;
  except
    Result := False;
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TSamplePlugIn.FindCallbackProc
  Author:    Marc Hoffmann
  DateTime:  2009/12/10
  Arguments: None
  Result:    TxpPlugInCallbackProc
-------------------------------------------------------------------------------}

function TSamplePlugIn.FindCallbackProc: TxpPlugInCallbackProc;
var
  i: Integer;
  CallbackProcStruct: PCallbackProcStruct;
begin
  Result := nil;
  for i := 0 to FCallbackProcs.Count - 1 do
  begin
    CallbackProcStruct := PCallbackProcStruct(FCallbackProcs[i]);
    @Result := CallbackProcStruct^.CallbackProc;
    Break;
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TSamplePlugIn.Execute
  Author:    Marc Hoffmann
  DateTime:  2009/12/10
  Arguments: const LastName, FirstName: string
  Result:    None
-------------------------------------------------------------------------------}

procedure TSamplePlugIn.Execute(const LastName, FirstName: string);
var
  CallbackProc: TxpPlugInCallbackProc;
  CallbackStruct: TCallbackStruct;
begin
  CallbackProc := ISamplePlugIn(Self).FindCallbackProc;
  if not(Assigned(CallbackProc)) then
    Exit;
  CallbackStruct.LastName := LastName;
  CallbackStruct.FirstName := FirstName;
  CallbackProc('12345', @CallbackStruct);
end;

end.

Bringt Euch das weiter?

Lieben Gruß,
kaju