Recent

Author Topic: SengMessage WM_COPYDATA . Target doesn't receive anything  (Read 13570 times)

anna

  • Sr. Member
  • ****
  • Posts: 426
SengMessage WM_COPYDATA . Target doesn't receive anything
« on: June 28, 2013, 03:47:47 pm »
I take sources from : http://delphi.about.com/od/windowsshellapi/a/wm_copydata.htm
Then user Convert Delphi project to Lazarus project. Solve errors and get such code:
SENDER:
unit SenderMain;
{$MODE Delphi}
interface
uses
  LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,
(*VVVV added*)
  windows;
(*^^^^ added*)
type

(*
  Declared in Windows.pas

  TCopyDataStruct = packed record
    dwData: DWORD; //up to 32 bits of data to be passed to the receiving application
    cbData: DWORD; //the size, in bytes, of the data pointed to by the lpData member
    lpData: Pointer; //Points to data to be passed to the receiving application. This member can be nil.
  end;

*)
  TCopyDataType = (cdtString = 0, cdtImage = 1, cdtRecord = 2);

  TSampleRecord = packed record
    s : string[50];
    i : integer;
    d : TDateTime;
  end;
(*VVVV added*)
  TWMCopyData = packed record
    Msg: Cardinal;
    From: HWND;
    CopyDataStruct: PCopyDataStruct;
    Result: Longint;
  end;
(*^^^^ added*)
  TSenderMainForm = class(TForm)
    SendDataButton: TButton;
    rgCopyOptions: TRadioGroup;
    procedure SendDataButtonClick(Sender: TObject);
  private
    procedure SendData(copyDataStruct : TCopyDataStruct);

    procedure SendString();
    procedure SendImage();
    procedure SendRecord();
  public
    { Public declarations }
  end;

var
  SenderMainForm: TSenderMainForm;

implementation

{$R *.lfm}

procedure TSenderMainForm.SendData(
  copyDataStruct: TCopyDataStruct);
var
  receiverHandle  : THandle;
  res : integer;
begin
  receiverHandle := FindWindow(PChar('TReceiverMainForm'),PChar('ReceiverMainForm'));
  if receiverHandle = 0 then
  begin
    ShowMessage('CopyData Receiver NOT found!');
    Exit;
  end;

  res := SendMessage(receiverHandle, WM_COPYDATA, Integer(Handle), Integer(@copyDataStruct));

  if res > 0 then ShowMessage(Format('Receiver has %d lines in Memo!',[res]));
end;

procedure TSenderMainForm.SendDataButtonClick(Sender: TObject);
begin
  if rgCopyOptions.ItemIndex = -1 then
  begin
    ShowMessage('Nothing selected!');
    Exit;
  end;

  case rgCopyOptions.ItemIndex of
    0 : SendString;
    1 : SendImage;
    2 : SendRecord;
  end;
end;

procedure TSenderMainForm.SendImage();
var
  ms : TMemoryStream;
  //bmp : TBitmap;
  bmp : graphics.TBitmap;
  copyDataStruct : TCopyDataStruct;
begin
  ms := TMemoryStream.Create;
  try
    bmp := self.GetFormImage;
    try
      bmp.SaveToStream(ms);
    finally
      bmp.FreeImage;
    end;
    copyDataStruct.dwData := Integer(cdtImage); //use it to identify the message contents
    copyDataStruct.cbData := ms.Size;
    copyDataStruct.lpData := ms.Memory;

    SendData(copyDataStruct);
  finally
    ms.Free;
  end;
end;

procedure TSenderMainForm.SendRecord();
var
  sampleRecord : TSampleRecord;
  copyDataStruct : TCopyDataStruct;
begin
  sampleRecord.s := 'Hello Receiver';
  sampleRecord.i := 1973;
  sampleRecord.d := Now;

  copyDataStruct.dwData := Integer(cdtRecord); //use it to identify the message contents
  copyDataStruct.cbData := SizeOf(sampleRecord);
  copyDataStruct.lpData := @sampleRecord;

  SendData(copyDataStruct);

end;

procedure TSenderMainForm.SendString();
var
  stringToSend : string;
  copyDataStruct : TCopyDataStruct;
begin
  stringToSend := 'About Delphi Programming';

  copyDataStruct.dwData := Integer(cdtString); //use it to identify the message contents
  copyDataStruct.cbData := 1 + Length(stringToSend);
  copyDataStruct.lpData := PChar(stringToSend);

  SendData(copyDataStruct);
end;

end.


RECEIVER:
unit ReceiverMain;
{$MODE Delphi}
interface
uses
  LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,
(*VVVV added*)
  windows;
(*^^^^ added*)
type
  TCopyDataType = (cdtString = 0, cdtImage = 1, cdtRecord = 2);

  TSampleRecord = packed record
    s : string[50];
    i : integer;
    d : TDateTime;
  end;
  (*VVVV added*)
    TWMCopyData = packed record
      Msg: Cardinal;
      From: HWND;
      CopyDataStruct: PCopyDataStruct;
      Result: Longint;
    end;
  (*^^^^ added*)
  TReceiverMainForm = class(TForm)
    cdMemo: TMemo;
    receivedImage: TImage;
    procedure FormCreate(Sender: TObject);
  private
    procedure WMCopyData(var Msg : TWMCopyData); message WM_COPYDATA;

    procedure HandleCopyDataString(copyDataStruct : PCopyDataStruct);
    procedure HandleCopyDataImage(copyDataStruct : PCopyDataStruct);
    procedure HandleCopyDataRecord(copyDataStruct : PCopyDataStruct);
  public
    { Public declarations }
  end;

var
  ReceiverMainForm: TReceiverMainForm;

implementation

{$R *.lfm}

{ TReceiverMainForm }

procedure TReceiverMainForm.FormCreate(Sender: TObject);
begin
  cdMemo.Clear;
end;

procedure TReceiverMainForm.HandleCopyDataImage(
  copyDataStruct: PCopyDataStruct);
var
  ms: TMemoryStream;
begin
  ms := TMemoryStream.Create;
  try
    ms.Write(copyDataStruct.lpData^, copyDataStruct.cbData);
    ms.Position := 0;
    receivedImage.Picture.Bitmap.LoadFromStream(ms);
  finally
    ms.Free;
  end;

  cdMemo.Lines.Add(Format('Received image at %s',[DateToStr(Now)]));
end;

procedure TReceiverMainForm.HandleCopyDataRecord(
  copyDataStruct: PCopyDataStruct);
var
  sampleRecord : TSampleRecord;
begin
  sampleRecord.s := TSampleRecord(copyDataStruct.lpData^).s;
  sampleRecord.i := TSampleRecord(copyDataStruct.lpData^).i;
  sampleRecord.d := TSampleRecord(copyDataStruct.lpData^).d;

  cdMemo.Lines.Add(Format('Received record at %s',[DateToStr(Now)]));
  cdMemo.Lines.Add(Format('sampleRecord.s = %s',[sampleRecord.s]));
  cdMemo.Lines.Add(Format('sampleRecord.i = %d',[sampleRecord.i]));
  cdMemo.Lines.Add(Format('sampleRecord.d = %s',[DateToStr(sampleRecord.d)]));
end;

procedure TReceiverMainForm.HandleCopyDataString(
  copyDataStruct: PCopyDataStruct);
var
  s : string;
begin
  s := PChar(copyDataStruct.lpData);

  cdMemo.Lines.Add(Format('Received string "%s" at %s',[s, DateToStr(Now)]));
end;


procedure TReceiverMainForm.WMCopyData(var Msg: TWMCopyData);
var
  copyDataType : TCopyDataType;
begin
  copyDataType := TCopyDataType(Msg.CopyDataStruct.dwData);

  //Handle of the Sender
  cdMemo.Lines.Add(Format('WM_CopyData from: %d',[msg.From]));

  case copyDataType of
    cdtString: HandleCopyDataString(Msg.CopyDataStruct);
    cdtImage: HandleCopyDataImage(Msg.CopyDataStruct);
    cdtRecord: HandleCopyDataRecord(Msg.CopyDataStruct);
  end;

  //Send something back
  msg.Result := cdMemo.Lines.Count;
end;

end.




SendMessage always returns zero. No reaction from . Breakpoints on TReceiverMainForm.WMCopyData do not work.
WinXP SP3 Pro Russian 32-bit (5.1.2600)

ni0bi

  • Newbie
  • Posts: 4
Re: SengMessage WM_COPYDATA . Target doesn't receive anything
« Reply #1 on: June 28, 2013, 08:19:58 pm »
I've got the same problem! I need to receive WM_COPYDATA in lazarus but it doesn't work. I wrote simple programs:

Sender:
-------------------
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Windows;

type

  { TForm1 }
        TCopyDataStruct = packed record
 dwData: DWORD; //up to 32 bits of data to be passed to the receiving application
 cbData: DWORD; //the size, in bytes, of the data pointed to by the lpData member
 lpData: Pointer; //Points to data to be passed to the receiving application. This member can be nil.
 end;
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { private declarations }
  public

    { public declarations }
  end;

var
  Form1: TForm1;
  FReceiverFromWS : THandle;
implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
lCopyDataStruct: TCopyDataStruct;
Msg: String;
begin
     FReceiverFromWS := FindWindow(NIL,PChar('receiver'));
   if FReceiverFromWS = 0 then
      begin
         ShowMessage('CopyData receiver NOT found!');
         Exit;
      end;
    Msg := 'bla bla';
   lCopyDataStruct.dwData := 23432;
   lCopyDataStruct.cbData := 1 + Length(Msg);
   lCopyDataStruct.lpData := PChar(Msg);
   SendMessage(FReceiverFromWS, WM_COPYDATA, wParam(0), lParam(@lCopyDataStruct));
end;

end.
   
-----------------------



Receiver:
-----------------------
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, Windows;

type

  { TForm1 }
      TWMCopyData = packed record
 Msg: Cardinal;
 From: HWND;//Handle of the Window that passed the data
 CopyDataStruct: PCopyDataStruct; //data passed
 Result: Longint;//Use it to send a value back to the "Sender"
 end;
  TForm1 = class(TForm)
    Memo1: TMemo;
  private
    { private declarations }
    procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA;
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}
procedure TForm1.WMCopyData(var Msg: TWMCopyData);
begin
form1.Memo1.Lines.add('test');
end;
end.
-----------------------------------------

But this not working. I've tried version with wndproc but it not working too. Spy++ when I'm sending message shows:

<00001> 00420620 S WM_COPYDATA hwndFrom:(null) pcds:0213FD70
<00002> 00420620 R WM_COPYDATA fProcessed:False




ludob

  • Hero Member
  • *****
  • Posts: 1173
Re: SengMessage WM_COPYDATA . Target doesn't receive anything
« Reply #2 on: June 29, 2013, 08:31:47 am »
Lazarus does not handle messages below WM_USER automatically. This is very platform specific and lazarus is not compatible with Delphi here. See http://wiki.lazarus.freepascal.org/Win32/64_Interface#Processing_non-user_messages_in_your_window for a solution.

ni0bi

  • Newbie
  • Posts: 4
Re: SengMessage WM_COPYDATA . Target doesn't receive anything
« Reply #3 on: June 29, 2013, 09:17:26 am »
Thanks a lot! Its working very good :)

sraggio

  • Newbie
  • Posts: 1
Re: SengMessage WM_COPYDATA . Target doesn't receive anything
« Reply #4 on: January 24, 2014, 11:14:07 pm »
Use this:

Sending the message:

procedure TForm1.SendCopyData(hTargetWnd: HWND; ACopyDataStruct:TCopyDataStruct);
begin
  if hTargetWnd<>0 then
    SendMessage(hTargetWnd, WM_COPYDATA, Longint(Handle), Longint(@ACopyDataStruct))
  else
    ShowMessage('No Recipient found!');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  MyCopyDataStruct: TCopyDataStruct;
  hTargetWnd: HWND;
begin
  with MyCopyDataStruct do
  begin
    dwData:= 0; // may use a value do identify content of message
    cbData:= StrLen(PChar(Edit1.Text)) + 1;  //Need to transfer terminating #0 as well
    lpData:= PChar(Edit1.Text)
  end;
  // Search window by the window title
  hTargetWnd := FindWindow(nil,PChar('Message Receiver'));
  // Send Data
  SendCopyData(hTargetWnd,MyCopyDataStruct);
end;

// Send Image1 to other app
procedure TForm1.Button2Click(Sender: TObject);
var
  ms                         : TMemoryStream;
  MyCopyDataStruct  : TCopyDataStruct;
  hTargetWnd           : HWND;
begin
  ms:= TMemoryStream.Create;
  try
    Image1.Picture.Bitmap.SaveToStream(ms);
    with MyCopyDataStruct do
    begin
      dwData:= 1;
      cbData:= ms.Size;
      lpData:= ms.Memory;
    end;
    // Search window by the window title
    hTargetWnd:= FindWindow(nil,PChar('Message Receiver'));
    // Send the Data
    SendCopyData(hTargetWnd,MyCopyDataStruct);
  finally
    ms.Free;
  end;
end;

Receiving the message:

Var
  PrevWndProc: WNDPROC;
  frmReceiver: TForm;

implementation

function WndCallback(Ahwnd: HWND; uMsg: UINT; wParam: WParam; lParam: LParam):LRESULT; stdcall;
Var
  pMyData  : CopyDataStruct;
  ms       : TMemoryStream;
begin
  if uMsg=WM_COPYDATA then begin {Process it}
     pMyData:= PCopyDataStruct(lParam)^;
     Case pMyData.dwData of
     0    : begin
              frmReceiver.Label1.Caption:= PChar(pMyData.lpData);
            end;
     1    : begin
              ms:= TMemoryStream.Create;
              try
                 ms.Write(pMyData.lpData^, pMyData.cbData);
                 ms.Position := 0;
                 frmReceiver.Image1.Picture.Bitmap.LoadFromStream(ms);
              finally
                ms.Free;
              end;
            end;
     end;
     Exit;
  end;
  result:= CallWindowProc(PrevWndProc,Ahwnd,uMsg,WParam,LParam);
end;

procedure TfrmReceiver.FormCreate(Sender: TObject);
begin
  Caption:= 'Message Receiver'; // Set the right window name
  PrevWndProc:= Windows.WNDPROC(SetWindowLongPtr(Self.Handle,GWL_WNDPROC,PtrInt(@WndCallback)));
end;


 

TinyPortal © 2005-2018