Einem Callback eine Antwort geben?

[mirage228]

Hallo,

in meinem Programm rufe ich eine Funktion einer DLL auf. Als Parameter dieser Funktion ist auch eine Callback-Prozedur drinne, die Anforderungen an mein Programm stellen kann. Nun wollte ich auf den Ruf dieser DLL-Funktionen antworten und der DLL die benötigten Daten geben.

Ist dies irgendwie möglich ?

Thx.
mirage228

[Christian Seehase]

Moin Mirage,

ein kleines Beispiel dazu:

Delphi-Quellcode:

// Anwendung
type
  TcsCallback = procedure(const AsMessage : PChar);

  procedure CBApp(const ACallbackProc : TcsCallback); external 'callbackdll.dll';

implementation

{$R *.DFM}

procedure CalledBack(const AsMessage : PChar);
begin
  ShowMessage(AsMessage);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  CBApp(CalledBack);
end;

Delphi-Quellcode:

// DLL
type
  TcsCallBack = procedure(const AsMessage : PChar);

procedure CBApp(const ApCallback : TcsCallback);
begin
  ApCallback('TEST');
end;

exports CBApp;

Die Typendeklaration sollte man am Besten in eine Unit auslagern, die dann von beiden eingebunden wird.

[mirage228]

Hi Christian,

danke für deinen Rat. Nur leider war ich soweit bereits.

also, wie du ja im beispiel gezeigt hast, gibt die DLL ein Callback. Die Message wird nun angezeigt. Sagen wir ich wollte der DLL etwas zurückschreiben.

Ich dachte mir das so, dass ich in dem TcsCallback die übergebene Variable noch einmal verändere und zurück schreibe und die DLL das dan Weiterverarbeiten kann.

Beispiel:

Also in der DLL schicke ich ein Callback (ein String und ein Integer Parameter). In der Anwendung sind bestimmte Integer als Konstanten, wie z.B. "GIBMIR_DOCUMENT_TEXT" deklariert. In den String wollte ich dann den Text des aktuellen Dokumentes zurückschreiben, sodass die DLL damit was anfangen bzw. weiterverarbeiten kann.

mfG
mirage228

[Chewie]

Da DLL und Anwendung im selben Adressraum liegen, sollte das eigentlich gehen:

Delphi-Quellcode:

// Anwendung 
type 
  TcsCallback = procedure(var AsMessage : PChar); 

  procedure CBApp(const ACallbackProc : TcsCallback); external 'callbackdll.dll'; 

implementation 

{$R *.DFM} 

procedure CalledBack(var AsMessage : PChar); 
begin 
  ShowMessage(AsMessage);
  AsMessage  := AsMessage + ' - ' + DateTimetoStr(now); 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  CBApp(CalledBack); 
end;

Delphi-Quellcode:

// DLL
type
  TcsCallBack = procedure(var AsMessage : PChar);

procedure CBApp(const ApCallback : TcsCallback);
var
  AsMessage: PChar;
begin
  AsMessage := 'TEST';  
  ApCallback(AsMessage);  //jetzt wird der Wert in der Funktion verändert
  ShowMessage(AsMessage);  //kann jetzt <> 'TEST' sein
end;

exports CBApp;

[mirage228]

Hi Chewie,

funktioniert soweit, nur habe ich noch ein kleines Problem. Undzwar eine Fehlermeldung (am Ende des Codes)

in meiner Anwendungs siehts so aus

Delphi-Quellcode:

unit uTools;

interface

uses Windows, Forms, Dialogs, SysUtils, ShellAPI;

type
  TCallBack = procedure(iMsg: Integer; var sMessage: PChar);
  TDLLCall  = procedure(const Callback: TCallBack);
  THandle   = integer;

type
  TAlphaCodeTool = class

  private
    fFileName: String;
    fParameter: String;

  public
    property filename: string read fFileName write fFileName;
    property parameter: string read fParameter write fParameter;

    constructor Create(Filename, Param: string);

    procedure CallTool(const Callback: TCallback);
    procedure DLL_CallBack(iMsg: Integer; var sMessage: PChar);

    procedure Execute_Tool;
end;

const
  REQUEST_ACTIVE_DOCUMENT_TEXT = 1;
  REQUEST_ACTIVE_DOCUMENT_FILENAME = 2;
  SET_ACTIVE_DOCUMENTS_TEXT = 3;
  SET_EDITORMOD = 4;
  OPERATION_LOAD_DOCUMENT = 5;
  OPERATION_LOAD_DOCUMENT_W = 6;
  REQUEST_USER_STRING = 10;

implementation

constructor TAlphaCodeTool.Create(FileName, Param: String);
begin
  self.filename := filename;
  self.parameter := param;
end;

procedure TAlphaCodeTool.CallTool(const Callback: TCallback);
var
  Handle: THandle;
  Call: TDLLCall;
begin
  Handle := LoadLibrary(PChar(filename));
  if Handle <> 0 then
  begin
    @Call := GetProcAddress(Handle, 'CallDLL');
    if @Call <> nil then
      Call(CallBack);
    FreeLibrary(Handle);
  end;
end;

procedure TAlphaCodeTool.DLL_CallBack(iMsg: Integer; var sMessage: PChar);
begin
  case iMsg of
    REQUEST_USER_STRING: begin
                           sMessage := PCHAR(InputBox(FileName, 'Bitte Wert eingeben', ''));
                         end;
  end;
end;

procedure TAlphaCodeTool.Execute_Tool;
begin
  if AnsiLowerCase(ExtractFileExt(FileName)) = '.dll' then
    CallTool(DLL_CallBack) else // <-- Fehlermeldung hier: Inkompatible Typen: Reguläre Prozedur und Methodenzeiger.
    ShellExecute(0, 'open', @filename, @parameter, nil, SW_SHOWNORMAL);
end;

end.

was ist falsch?

mfG
mirage228

[Christian Seehase]

Moin Mirage,

wie die Fehlermeldung schon sagt:
Du müsstest die Adresse einer Prozedur, und nicht die einer Methode übergeben.

TAlphaCodeTool.DLL_CallBack ist aber die Methode der Klasse TAlphaCodeTool, und keine einfache Prozedur.
Wenn Du die aus der Klasse entfernst und als "normale" Prozedure einbindest müsste es gehen.
BTW: Das Problem hatten wir die letzte Zeit schon ein paar Mal.

[mirage228]

Hi Christian,

danke für den Hinweis.

Jetzt funktionierts ;-)

mfG
mirage228