用WM_COPYDATA发送消息出问题,请高手帮忙

hailang_zh 2004-10-12 05:41:35

我用WM_COPYDATA在两个独立的程序中传递消息,主要是传递字符串,遇到一个问题.

有时候连续发送几个消息过去接收方接收不到消息,一定要先激活一次接收方的窗体才能正常接收消息,也就是发送一次消息后,点击一下接收方的窗体再通过发送方程序发送消息接收方才能收到下一个消息.


发送方代码:
_________________________________

procedure TForm1.btnSendMessageClick(Sender: TObject);
var
ds: TCopyDataStruct;
hd: THandle;
temp:string;
begin
temp := trim(edt1.text);
ds.cbData := Length(temp) + 1;
GetMem (ds.lpData, ds.cbData );
StrCopy (ds.lpData, PChar (temp));
Hd := FindWindow (nil, '测试窗体');
if Hd <> 0 then
SendMessage (Hd, WM_COPYDATA, Handle,
Cardinal(@ds))
else
ShowMessage ('目标窗口没找到!');
FreeMem (ds.lpData);
end;

---------------------------------------------

接收方代码:

-----------------------
procedure TForm2.Mymessage(var t:TWmCopyData);
var
tempstr:string;
begin
tempstr :=trim ((StrPas(t.CopyDataStruct^.lpData)));
edt1.text := tempstr;
end;
...全文
183 5 打赏 收藏 举报
写回复
5 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
hailang_zh 2004-10-13
  • 打赏
  • 举报
回复
晕,老大,能否搞简单一点的啊,太复杂了啊,搞不懂。
hailang_zh 2004-10-13
  • 打赏
  • 举报
回复
呵呵,谢谢了,测试一下就结贴给分。
hottey 2004-10-13
  • 打赏
  • 举报
回复
20分的代价帖了N多代码,辛苦我啊555
hottey 2004-10-13
  • 打赏
  • 举报
回复
程序一(发消息):
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons;

type
TForm1 = class(TForm)
Memodata: TMemo;
BitBtn1: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
procedure WMSend();
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMSend();
var
Data: TCopyDataStruct;
Buffer: PChar;
BufferSize: Integer;
begin
BufferSize := Self.MemoData.GetTextLen + SizeOf(Char);
Buffer := AllocMem(BufferSize);
try
Self.MemoData.GetTextBuf(Buffer, BufferSize);
Data.cbData := BufferSize;
Data.lpData := Buffer;
SendMessage(FindWindow(nil, 'Form2'), WM_COPYDATA, Handle, Longint(@Data));
finally
FreeMem(Buffer);
end;
end;


procedure TForm1.BitBtn1Click(Sender: TObject);
begin
WMSend;
end;

end.


程序二(接收消息):
unit Unit2;

interface

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

type
TForm1 = class(TForm)
memodata: TMemo;
private
{ Private declarations }
procedure WMCopyData(var Message: TMessage);
public
procedure WndProc(var Message: TMessage); override;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.WndProc(var Message: TMessage);
begin
if Message.Msg = WM_COPYDATA then Self.WMCopyData(Message)
else inherited WndProc(Message);
end;


procedure TForm1.WMCopyData(var Message: TMessage);
begin
Caption := 'Get Data from Form1' ;
Self.MemoData.SetTextBuf(PChar(PCopyDataStruct(Message.LParam)^.lpData));
end;
end.

hottey 2004-10-12
  • 打赏
  • 举报
回复
给你贴个完整的例子吧。你运行此程序的两个实例就行!
unit Main;

interface

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

type
TMainForm = class(TForm)
MemoData: TMemo;
ButtonExit: TButton;
ButtonTransfer: TButton;
procedure ButtonExitClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ButtonTransferClick(Sender: TObject);
private
{ Private declarations }
protected
procedure WMCopyData(var Message: TMessage);
procedure WMRequest(var Message: TMessage);
procedure WMSend(var Message: TMessage);
procedure WMAcknowledge(var Message: TMessage);
procedure WndProc(var Message: TMessage); override;
public
{ Public declarations }
end;

var
MainForm: TMainForm;

implementation

{$R *.dfm}

const
SReqMsg = 'JuCopyData.Request';
SAckMsg = 'JuCopyData.Acknowledgement';
SSendMsg = 'JuCopyData.Send';

var
FormTitle: string = 'Copy Data';

var
ReqMsgId, AckMsgId, SendMsgId: Cardinal;
Recipients: DWORD = BSM_APPLICATIONS;

procedure TMainForm.ButtonExitClick(Sender: TObject);
begin
Application.Terminate();
end;

procedure TMainForm.ButtonTransferClick(Sender: TObject);
begin
Windows.BroadcastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE, @Recipients, ReqMsgId, Self.Handle, Application.Handle);
end;

procedure TMainForm.WMAcknowledge(var Message: TMessage);
begin
Perform(SendMsgId, Message.WParam, Message.LParam);
Caption := FormTitle + ' - Server';
end;

procedure TMainForm.WMCopyData(var Message: TMessage);
begin
Caption := FormTitle + ' - Client - From Window $' + IntToHex(Message.WParam, 8);
if PCopyDataStruct(Message.LParam)^.dwData = SendMsgId then
begin
Self.MemoData.SetTextBuf(PChar(PCopyDataStruct(Message.LParam)^.lpData));
end;
end;

procedure TMainForm.WMRequest(var Message: TMessage);
begin
PostMessage(HWND(Message.WParam), AckMsgId, Handle, Application.Handle);
Caption := FormTitle + ' - Client';
end;

procedure TMainForm.WMSend(var Message: TMessage);
var
Data: TCopyDataStruct;
Buffer: PChar;
BufferSize: Integer;
begin
BufferSize := Self.MemoData.GetTextLen + SizeOf(Char);
Buffer := AllocMem(BufferSize);
try
Self.MemoData.GetTextBuf(Buffer, BufferSize);
Data.dwData := SendMsgId;
Data.cbData := BufferSize;
Data.lpData := Buffer;
SendMessage(HWND(Message.WParam), WM_COPYDATA, Handle, Longint(@Data));
finally
FreeMem(Buffer);
end;
end;

procedure TMainForm.WndProc(var Message: TMessage);
begin
if Message.Msg = ReqMsgId then Self.WMRequest(Message)
else if Message.Msg = AckMsgId then Self.WMAcknowledge(Message)
else if Message.Msg = SendMsgId then Self.WMSend(Message)
else if Message.Msg = WM_COPYDATA then Self.WMCopyData(Message)
else inherited WndProc(Message);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
Caption := FormTitle;
end;

initialization
ReqMsgId := RegisterWindowMessage(SReqMsg);
AckMsgId := RegisterWindowMessage(SAckMsg);
SendMsgId := RegisterWindowMessage(SSendMsg);

end.
发帖
Windows SDK/API

1177

社区成员

Delphi Windows SDK/API
社区管理员
  • Windows SDK/API社区
加入社区
帖子事件
创建了帖子
2004-10-12 05:41
社区公告
暂无公告