WM_COPYDATA zwischen Delphi- und Freepascalprogramm

[delphifan2004]

Hallo,

ich habe einen Client und einen Server, die ich in Freepascal bzw. Delphi geschrieben habe. Zum Beispiel den Client in Delphi, den Server in Freepascal. Könnte aber auch genau andersrum sein.

Wichtig ist: Eines der Programme, die per WM_COPYDATA miteinander kommunizieren sollen ist in Freepascal geschrieben, während das Andere in Delphi vorliegt.

Vom Freepascal- zum Delphiprogramm funktioniert die Übertragung.

Jedoch vom Delphiprogramm zu dem in Freepascal geschriebenen kommt nix an.

Warum?

Wenn ich wie in Delphi als Name den Fenstertitel für das TARGET_WINDOW verwende, das den Namen des
Freepascal-Programmes/Programmfensters repräsentiert, erhalte ich im Delphiprogramm, das mit dem Freepascalprogramm kommunizieren und dazu Daten senden soll, die Meldung: 'No recipient found!'.
Wenn ich stattdessen den Namen der .exe Datei, ohne Erweiterung, verwende, kommt die Meldung nicht mehr, aber es kommen keine Daten an.

Die Konstante TARGET_WINDOW findet in der Methode SendData() Verwendung.

Senden vom Freepascal-Programm an das Delphi Programm funktioniert dagegen. Als Name für das entfernte Delphiprogramm funktioniert der Fenstertitel.

Warum klappt das im Freepascal Programm nicht?

Und: was muss ich stattdessen machen, damit das Delphi Programm auch Daten an das Freepascalprogramm senden kann?

Kann es sein, das die Typumwandlung "Result:=String(sText)" in der Methode ReceiveData zwar in Delphi, nicht jedoch in Freepascal klappt.

Allerdings wird lblStatus.Caption im Server nicht verändert, was ja wiederum der Fall sein müsste, wenn eine leerer String übergeben würde.

Delphi-Quellcode:

//Dieser Client sei das mit Delphi geschriebene Programm:

type
  TfrmClient = class(TForm)
    btnReceive: TButton;
    pClientShow: TMemo;
    btnSend: TButton;
    procedure FormCreate(Sender: TObject);
    procedure btnReceiveClick(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    procedure SendData(AData: String); //gleiche Implementierung, wie auf Server   
    procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA;
  public

  end;
  
//Dieser Server sei in Freepascal/Lazarus geschrieben:

type
  TServer = class(TForm)
    btnTestCmd: TButton;
    lblStatus: TLabel;
    procedure btnTestCmdClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private declarations }
   
   
    function ReceiveData(var Msg: TWMCopyData): String;
    procedure SendData(AData: String);
  public
    procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA;

implementation

uses Strings

function TServer.ReceiveData(var Msg: TWMCopyData): String;
var
  sText: array[0..163] of Char;
begin
  // generate text from parameter
  // anzuzeigenden Text aus den Parametern generieren
  {$ifdef FPC}
  StrLCopy(sText, Msg.CopyDataStruct^.lpData, Msg.CopyDataStruct^.cbData);
  {$else}
  StrLCopy(sText, Msg.CopyDataStruct.lpData, Msg.CopyDataStruct.cbData);
  {$endif}
  // write received text
  // Empfangenen Text ausgeben
  Result := String(sText);
  //pClientShow.Lines.Add(String(sText));
end;

procedure TServer.SendData(AData: String);
var
  aCopyData: TCopyDataStruct;
  aCopyPntr: Longint; //falls Typumwandlungen nötig
  hTargetWnd: HWND;
begin
  with aCopyData do
  begin
    dwData := 0;
    cbData := StrLen(PChar(AData)) + 1;
    lpData := PChar(AData)
  end;
  aCopyPntr:= Longint(@aCopyData);  //falls Typumwandlungen nötig
  // Search window by the window title
  // Fenster anhand des Titelzeilentext suchen
  hTargetWnd := FindWindowEx(0, 0, nil, PChar(TARGET_WINDOW));
  if hTargetWnd <> 0 then
    SendMessage(hTargetWnd,
       WM_COPYDATA,
       Longint(Handle),
       Longint(@aCopyData)
    )
  else
    ShowMessage('No recipient found!');
end;

procedure TServer.WMCopyData(var Msg: TWMCopyData); 
begin
  lblStatus.Caption := ReceiveData(Msg);
end;

end.

Habe nur die Freepascal Seite mit Implementationsteil angegeben. Vom FPC-Programm aus kann ich ja an das Delphi Programm senden, nur nicht von diesem Empfangen.


Wer kann mir weiter helfen?


P.S: Das Beispiel hab ich hier aus der DP, wenn auch geringfügig geändert.

[Luckie]

Zitat von delphifan2004:

Wenn ich stattdessen den Namen der .exe Datei, ohne Erweiterung, verwende, kommt die Meldung nicht mehr, aber es kommen keine Daten an.

Das kann nicht funktionieren. Du brauchst das Fensterhandle des Zielprogrammes. Kann es sein, dass du ihn falsch geschrieben hast oder so?

[delphifan2004]

Zitat von Luckie:

Zitat von delphifan2004:

Wenn ich stattdessen den Namen der .exe Datei, ohne Erweiterung, verwende, kommt die Meldung nicht mehr, aber es kommen keine Daten an.

Das kann nicht funktionieren. Du brauchst das Fensterhandle des Zielprogrammes. Kann es sein, dass du ihn falsch geschrieben hast oder so?

Nee, Schreibfehler kann ich keinen entdecken. Das Zielfenster heißt "Server" Das ist es nicht.

Aber ich habe mir die Datenstrukturen PCopyDataStruct und TCopyDataStruct auf der Freepascal Seite selber definiert, weil Freepascal diesen Typ nicht zu kennen scheint. Das Hinzufügen der Units "Windows" und "Messages" bringt mir diesen Datentyp bei Freepascal nicht.

Aber die Datenstruktur muss doch auf jeden Fall so sein, damit ich die Daten aislesen kann?

Verwendet Freepascal da einen Anderen Messagetyp? Wenn ja, wie muss der heißen?
Habe soeben versucht, statt TWMCopyData als Übbergabetyp TMessage für WMCopyData zu verwenden. Bringt aber nicht den gewünschten Erfolg. Habe auch in ReceiveData des Servers eine Methode ConvertMessage aufgerufen, die ich so hier implementiert habe:


In der Methode ReceiveData() hab ich mir dann eine Variable CMsg: TWMCopyData definiert, die mit den
TMessage Daten gefüllt wird und dann auch zum Lesen der Daten verwendet wird.

Delphi-Quellcode:

//Der Freepascal Teil:
type
  {$IFDEF FPC}
  {$ifdef Win32}
  PCopyDataStruct = ^TCopyDataStruct;
  {$EXTERNALSYM tagCOPYDATASTRUCT}
  tagCOPYDATASTRUCT = packed record
    dwData: DWORD;
    cbData: DWORD;
    lpData: Pointer;
  end;
  TCopyDataStruct = tagCOPYDATASTRUCT;

  TWMCopyData = packed record
    Msg: Cardinal;
    From: HWND;
    CopyDataStruct: PCopyDataStruct;
    Result: Longint;
  end;
  {$else}
  PCopyDataStruct = ^TCopyDataStruct;
  tagCOPYDATASTRUCT = packed record

  end;
  TCopyDataStruct = tagCOPYDATASTRUCT;

  TWMCopyData = packed record
  end;
  {$endif}
  {$ENDIF} { von ifdef FPC }


//Wegen des Versuchs in ReceiveData und WMCopyData() TMessage statt TWMCopyData zu testen
function TServer.ConvertMessage(const Msg: TMessage): TWMCopyData;
begin
  move(msg, result, sizeof(TMessage));
end;

//Und hier die geänderte ReceiveData() Methode
function TServer.ReceiveData(var Msg: {$ifdef fpc}TMessage{$else}TWMCopyData{$endif}): String;
var
  sText: array[0..163] of Char;
  CMsg: TWMCopyData;
begin
  // generate text from parameter
  // anzuzeigenden Text aus den Parametern generieren
  {$ifdef FPC}
  CMsg := ConvertMessage(Msg);
  StrLCopy(sText, CMsg.CopyDataStruct^.lpData, CMsg.CopyDataStruct^.cbData);
  //führt aber nicht zum Erfolg, ist wieder auf den alten Stand zurück geändert
  {$else}
  StrLCopy(sText, Msg.CopyDataStruct.lpData, Msg.CopyDataStruct.cbData);
  {$endif}
  // write received text
  // Empfangenen Text ausgeben
  Result := String(sText);
  //pClientShow.Lines.Add(String(sText));
end; 



//==========================================================================

Das Delphi Programm, hier als Client:

const
  TARGET_WND = "Server";

procedure TClient.btnSendClick(Sender: TObject);
begin
  Send;
end;

procedure TClient.Send;
var
  aCopyData: TCopyDataStruct;
  hTargetWnd: HWND;
begin
 with aCopyData do
  begin
    dwData := 0;
    cbData := StrLen(PChar(pClientShow.Lines[0])) + 1;
    lpData := PChar(pClientShow.Lines[0]);
  end;
  // Search window by the window title
  // Fenster anhand des Titelzeilentext suchen
  hTargetWnd := FindWindowEx(0, 0, nil, PChar(TARGET_WND));
  if hTargetWnd <> 0 then
    SendMessage(hTargetWnd, WM_COPYDATA, Longint(Handle), Longint(@aCopyData))
  else
    ShowMessage('No Recipient found!');
end;

Kann es sein, das die Berechnung des Handle auf der Freepascal Seite anders erfolgen muss. Die Zeigerarithmetik unterscheidet sich von der in DElphi, soviel ich weiß. Und ich hatte

[Astat]

Hallo delphifan2004, WM_COPYDATA ist in der LCL wegen Platform Kompatibilität nicht integriert, für Windows musst du

mit SetWindowLong + gwl_WndProc die WndProc anzapfen.

Anbei Sample.

Delphi-Quellcode:

var
  WProc: pointer;

function NewWndProc(Handle: hWnd; Msg, wParam, lParam: Longint): Longint; stdcall;
begin
  if Msg = WM_COPYDATA then begin
    showmessage('Treffer');
  end else
    Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  WProc := Pointer(SetWindowLong(handle, gwl_WndProc, Integer(@NewWndProc)));
end;

lg. Astat

[delphifan2004]

Hallo Astat!

Danke für den Tipp. So kann natürlich meine erstere Version nicht funktionieren.

Aber ich muss dennoch wieder nachfragen. Ich erhalte nämlich die folgende Fehlermeldung vom FPC Compiler:


server.pas(54,35) Error: Incompatible type for arg no. 1: Got "<procedure variable type of function(LongWord, LongWord, LongInt, LongInt):LongInt;Register>", expected "<procedure variable type of function(LongWord, LongWord, LongInt, LongInt):LongInt;S

Ich habe deshalb den Typ von WProc in den unten stehenden geändert:

Delphi-Quellcode:

var WProc: function (H: hWnd; msg: LongWord; w, l: LongInt): Longint; stdcall;

function NewWndProc(Handle: hWnd; Msg: LongWord; wParam, lParam: Longint): Longint; stdcall;
begin
  if Msg = WM_COPYDATA then begin
    showmessage('Treffer');
  end else
    Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;

Leider kenne ich mich mit dem Windows API nicht so gut aus.

Wie baue ich die NewWndProc nun in meine Formular ein?

Wenn ich das hier in FormCreate() schreibe:

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
begin
  WProc := Pointer(SetWindowLong(handle, gwl_WndProc, Integer(@NewWndProc)));
end;

//Deshalb habe ich diese Zeile so hier geändert:

procedure TForm1.FormCreate(Sender: TObject);
begin
  WProc := SetWindowLong(handle, gwl_WndProc, Integer(@NewWndProc));
end;

//da ich ja die Variable WProc in den richtigen Funktionstypen geändert habe

erhalte ich diese Fehlermeldung vom FPC Compiler:

server.pas(60,12) Error: Incompatible types: got "LongInt" expected "<procedure variable type of function(LongWord, LongWord, LongInt, LongInt):LongInt;StdCall>"

WProc ist außerdem eine Nutzerdefinierte Variable.

Nun muss ja aber irgendwo in den Tiefen des Windows API eine Zuweisung der neuen WindowProc stehen.
Welchen Zeiger muss ich da an Stelle von WProc verwenden?

Oder muss ich in der schon definierten WMCopyData() Methode WProc aufrufen?

[grl]

Hallo DelphiFan!

Wie Astat schon geschrieben hat, ist WM_COPYDATA aus kompatibilitätsgründen nicht implementiert.

Solltest du es dir selbst einbauen wollen (dafür musst du natürlich die LCL neu kompilieren!) ist es wie folgt zu machen:

In der Datei lcl\interfaces\win32\win32callback.inc werden in der Funktion WindowProc alle dort nicht angeführten Messages "geschluckt" und nicht an den Window-eigenen Messagehandler weitergeleitet.

Das kann man beheben in dem man in dieser Funktion die WM_COPYDATA nachrüstet.
Such in dieser Funktion nach dem Handling für WM_ACTIVATE und füge für WM_COPYDATA folgendes ein:

Delphi-Quellcode:

    WM_COPYDATA: //passthrough of WM_COPYDATA messages for Delphi-Compatibility
    begin
      LMessage.Msg := Msg;
      LMessage.WParam := WParam;
      LMessage.LParam := LParam;
      WinProcess := false;
    end;

Damit funktioniert (das auch von mir sehr exzessiv verwendete) WM_COPYDATA genau gleich wie unter Delphi.

Gruß
GRL

[implementation]

Zitat:

Kann es sein, das die Typumwandlung "Result:=String(sText)" in der Methode ReceiveData zwar in Delphi, nicht jedoch in Freepascal klappt.

Kommt drauf an, ob die Compiler-Direktive {$longstrings} eingeschaltet ist.
Falls ja, müsste die Typkonvertierung eigentlich funzen.
Falls nein, solltest du die Zeile so ändern: Result := AnsiString(sText);

[ADD]

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject); 
begin 
  WProc := SetWindowLong(handle, gwl_WndProc, Integer(@NewWndProc)); 
end;

Änder das mal in

Delphi-Quellcode:

type TWProc = function (H: hWnd; msg: LongWord; w, l: LongInt): Longint; stdcall;
var WProc: TWProc;
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  WProc := TWProc(SetWindowLong(handle, gwl_WndProc, Integer(@NewWndProc))); 
end;

SetWindowLong liefert nämlich einen Longint zurück.

[delphifan2004]

Hallo @implementation,

Danke, so klappt es mit der Übertragung. Der Treffer erscheint. Wie ich es haben wollte!

Wie aber kann ich jetzt meine Daten empfangen?

Die NewWindowProc ist ja nicht als Formularmethode definiert.

Deshalb habe ich das hier versucht:

Delphi-Quellcode:

function NewWndProc(Handle: hWnd; Msg: LongWord; wParam, lParam: Longint): Longint; stdcall;
var
  wMessage: TMessage;                //Msg,wParam,lParam in TMessage-Struktur 
  wmCopyDataMessage: TWMCopyData;    //die benötigte TWMCopyData-Struktur
begin
  if Msg = WM_COPYDATA then begin
    showmessage('Treffer');
    if Assigned(Server) then 
      //=== Das hier funktioniert nicht === Compiler sagt Argument cant' assigned to ===
      //hier will ich meine WMCopyData() Methode aufrufen, die die Message 
      //mit meinen Daten übernimmt, um diese Daten verarbeiten zu können.
      //with Server do
      //WMCopyData(ConvertMessage(CopyMessage(Msg, wParam, lParam)));
      

    //ABER SO HIER FUNKTIONIERT DIE DATENÜBERTRAGUNG PERFEKT:::
    with Server do
    begin
      wMessage := CopyMessage(Msg, wParam, lParam);
      wmCopyDataMessage := ConvertMessage(wMessage);
      with GDBDebugServer do
      WMCopyData(wmCopyDataMessage);
    end;
    //==========================================================
  end else
    Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
end;

function TServer.CopyMessage(Msg: LongWord; WParam, LParam: Longint
  ): TMessage;
begin
  Result.msg:=Msg;
  Result.wParam:=WParam;
  Result.lParam:=LParam;
end;

function TServer.ConvertMessage(const Msg: TMessage): TWMCopyData;
begin
  move(msg, result, sizeof(TMessage));
end;

Danke Euch allen für Eure Hilfe!!!


@grl: Habe die Änderung in win32Callback.inc übernommen und die LCL neu übersetzt!

Wer also das Beispiel hier nachvollziehen will, muss die genannte Änderung in win32CallBack.inc (siehe Beitrag von @grl) vorher vornehmen und dann die LCL neu übersetzen!