Delphi-线程中的消息泵未接收到WM_COPYDATA消息 [英] Delphi - Message pump in thread not receiving WM_COPYDATA messages

查看：155
本文介绍了Delphi-线程中的消息泵未接收到WM_COPYDATA消息的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我正在尝试（在D7中）使用消息泵建立线程，最终我希望将其移植到DLL中。



以下是相关内容/我的代码的重要部分：

  const 
 WM_Action1 = WM_User +1; 
 scThreadClassName =‘MyThreadClass’； 
 
 type 
 TThreadCreatorForm = class; 
 
 TWndThread = class（TThread）
 private 
 FTitle：字符串； 
 FWnd：HWND； 
 FWndClass：WNDCLASS； 
 FCreator：TForm； 
过程HandleAction1; 
受保护的
程序执行；覆盖
 public 
构造函数Create（ACreator：TForm; const Title：String）; 
结尾； 
 
 TThreadCreatorForm = class（TForm）
 btnCreate：TButton; 
 btnAction1：TButton; 
标签1：TLabel； 
 btnQuit：TButton; 
 btnSend：TButton; 
 edSend：TEdit; 
过程FormShow（Sender：TObject）; 
过程btnCreateClick（Sender：TObject）; 
过程btnAction1Click（Sender：TObject）; 
过程btnQuitClick（Sender：TObject）; 
过程btnSendClick（Sender：TObject）; 
过程WMAction1（var Msg：TMsg）;消息WM_Action1; 
过程FormCreate（Sender：TObject）; 
 public 
 {公共声明} 
 WndThread：TWndThread; 
 ThreadID：整数; 
 ThreadHWnd：HWnd; 
结尾； 
 
 var 
 ThreadCreatorForm：TThreadCreatorForm; 
 
实现
 
 {$ R * .DFM} 
 
过程SendStringViaWMCopyData（HSource，HDest：THandle; const AString：String）; 
 var 
 Cds：TCopyDataStruct; 
 Res：整数； 
开始
 FillChar（Cds，SizeOf（Cds），0）; 
 GetMem（Cds.lpData，Length（Astring）+ 1）; 
试试
 StrCopy（Cds.lpData，PChar（AString））; 
 Res：= SendMessage（HDest，WM_COPYDATA，HSource，Cardinal（@Cds））; 
 ShowMessage（IntToStr（Res））; 
最终
 FreeMem（Cds.lpData）; 
结尾； 
结尾； 
 
过程TThreadCreatorForm.FormShow（Sender：TObject）; 
 begin 
 ThreadID：= GetWindowThreadProcessId（Self.Handle，Nil）; 
 Assert（ThreadID = MainThreadID）; 
结尾； 
 
过程TWndThread.HandleAction1; 
开始
 // 
结束； 
 
构造函数TWndThread.Create（ACreator：TForm; const Title：String）; 
开始
继承了Create（True）; 
 FTitle：=标题； 
 FCreator：= ACreator; 
 FillChar（FWndClass，SizeOf（FWndClass），0）; 
 FWndClass.lpfnWndProc：= @DefWindowProc; 
 FWndClass.hInstance：= HInstance; 
 FWndClass.lpszClassName：= scThreadClassName; 
结尾； 
 
过程TWndThread.Execute; 
 var 
 Msg：TMsg; 
完成：布尔值； 
 S：字符串;如果Windows.RegisterClass（FWndClass）= 0，则
以
开头，然后退出； 
 FWnd：= CreateWindow（FWndClass.lpszClassName，PChar（FTitle），WS_DLGFRAME，0，0，0，0，0，0，HInstance，nil）; 
如果FWnd = 0，则退出； 
 
完成：= False; 
，而GetMessage（Msg，0，0，0）并没有完成，则以
的情况为例。 
结尾； 
 WM_COPYDATA：开始
 Assert（True）; 
结尾； 
 WM_Quit：完成：= True; 
 else begin 
 TranslateMessage（msg）; 
 DispatchMessage（msg）
结尾； 
结尾； {case} 
结尾；如果FWnd<> 
 0然后
 DestroyWindow（FWnd）; 
 Windows.UnregisterClass（FWndClass.lpszClassName，FWndClass.hInstance）; 
结尾；

一旦创建了线程，就可以使用FindWindow找到它的窗口句柄，并且可以正常工作。 / p>

如果我 PostMessage 它是我的用户定义的WM_Action1消息，则该消息将由GetMessage（）接收，并被线程的Execute中的case语句捕获



如果我使用可以正常工作的SendStringViaWMCopyData（）例程向自己（即我的宿主表单）发送WM_CopyData消息。



但是：如果我向线程发送WM_CopyData消息，则Execute中的GetMessage和case语句将永远看不到它，而SendStringViaWMCopyData中的SendMessage返回0。



所以，我的问题是，为什么.Execute中的GetMessage无法接收到WM_CopyData消息？我有种不舒服的感觉……

解决方案

WM_COPYDATA 不是已发布消息，而是已发送消息，因此它不会通过消息队列，因此消息循环将永远不会看到它。您需要为窗口类分配一个窗口过程，并在该过程中处理 WM_COPYDATA 。不要使用 DefWindowProc（）作为窗口过程。



此外，发送时WM_COPYDATA ， lpData 字段以字节表示，而不是以字符表示，因此您需要考虑到这一点。而且您没有正确填写 COPYDATASTRUCT 。您需要为 dwData 和 cbData 字段提供值。并且您不需要为 lpData 字段分配内存，您可以将其指向 String 的现有内存



尝试一下：

  const 
 WM_Action1 = WM_User +1; 
 scThreadClassName =‘MyThreadClass’； 
 
 type 
 TThreadCreatorForm = class; 
 
 TWndThread = class（TThread）
 private 
 FTitle：字符串; 
 FWnd：HWND； 
 FWndClass：WNDCLASS； 
 FCreator：TForm； 
过程WndProc（var Message：TMessage）; 
过程HandleAction1; 
过程HandleCopyData（const Cds：TCopyDataStruct）; 
受保护的
程序执行；覆盖
程序DoTerminate;覆盖
 public 
构造函数Create（ACreator：TForm; const Title：String）; 
结尾； 
 
 TThreadCreatorForm = class（TForm）
 btnCreate：TButton; 
 btnAction1：TButton; 
标签1：TLabel； 
 btnQuit：TButton; 
 btnSend：TButton; 
 edSend：TEdit; 
过程FormShow（Sender：TObject）; 
过程btnCreateClick（Sender：TObject）; 
过程btnAction1Click（Sender：TObject）; 
过程btnQuitClick（Sender：TObject）; 
过程btnSendClick（Sender：TObject）; 
过程WMAction1（var Msg：TMsg）;消息WM_Action1; 
过程FormCreate（Sender：TObject）; 
 public 
 {公共声明} 
 WndThread：TWndThread; 
 ThreadID：整数; 
 ThreadHWnd：HWnd; 
结尾； 
 
 var 
 ThreadCreatorForm：TThreadCreatorForm; 
 
实现
 
 {$ R * .DFM} 
 
 var 
 MY_CDS_VALUE：UINT = 0； 
 
过程SendStringViaWMCopyData（HSource，HDest：HWND; const AString：String）; 
 var 
 Cds：TCopyDataStruct; 
 Res：整数； 
开始
 ZeroMemory（@Cds，SizeOf（Cds））; 
 Cds.dwData：= MY_CDS_VALUE; 
 Cds.cbData：=长度（AString）* SizeOf（字符）; 
 Cds.lpData：= PChar（AString）; 
 Res：= SendMessage（HDest，WM_COPYDATA，HSource，LPARAM（@Cds））; 
 ShowMessage（IntToStr（Res））; 
结尾； 
 
过程TThreadCreatorForm.FormShow（Sender：TObject）; 
 begin 
 ThreadID：= GetWindowThreadProcessId（Self.Handle，Nil）; 
 Assert（ThreadID = MainThreadID）; 
结尾； 
 
函数TWndThreadWindowProc（hWnd：HWND; uMsg：UINT; wParam：WPARAM; lParam：LPARAM）：LRESULT; stdcall; 
 var 
 pSelf：TWndThread; 
消息：TMessage; 
 begin 
 pSelf：= TWndThread（GetWindowLongPtr（hWnd，GWL_USERDATA））;如果pSelf<> 
 nil然后
开始
 Message.Msg：= uMsg; 
 Message.WParam：= wParam; 
 Message.LParam：= lParam; 
 Message.Result：= 0; 
 pSelf.WndProc（Message）; 
结果：= Message.Result; 
 end else 
结果：= DefWindowProc（hWnd，uMsg，wParam，lParam）; 
结尾； 
 
构造函数TWndThread.Create（ACreator：TForm; const Title：String）; 
开始
继承了Create（True）; 
 FTitle：=标题； 
 FCreator：= ACreator; 
 FillChar（FWndClass，SizeOf（FWndClass），0）; 
 FWndClass.lpfnWndProc：= @TWndThreadWindowProc; 
 FWndClass.hInstance：= HInstance; 
 FWndClass.lpszClassName：= scThreadClassName; 
结尾； 
 
过程TWndThread.Execute; 
 var 
 Msg：TMsg;如果Windows.RegisterClass（FWndClass）= 0，则
以
开头，然后退出； 
 FWnd：= CreateWindow（FWndClass.lpszClassName，PChar（FTitle），WS_DLGFRAME，0，0，0，0，0，0，HInstance，nil）; 
如果FWnd = 0，则退出； 
 SetWindowLongPtr（FWnd，GWL_USERDATA，ULONG_PTR（Self））; 
 
，而GetMessage（Msg，0，0，0）和（未终止）执行
开始
 TranslateMessage（msg）; 
 DispatchMessage（msg）; 
结尾； 
结尾； 
 
过程TWndThread.DoTerminate;如果FWnd<> ;，则
从
开始。 0然后
 DestroyWindow（FWnd）; 
 Windows.UnregisterClass（FWndClass.lpszClassName，FWndClass.hInstance）; 
继承了； 
结尾； 
 
过程TWndThread.WndProc（var Message：TMessage）; 
 begin 
 case Message.Msg of 
 WM_Action1：开始
 HandleAction1; 
出口； 
结尾； 
 WM_COPYDATA：如果PCopyDataStruct（lParam）.dwData = MY_CDS_VALUE，则从
开始，然后
开始
 HandleCopyData（PCopyDataStruct（lParam）^）; 
出口； 
结尾； 
结尾； 
结尾； 
 
 Message.Result：= DefWindowProc（FWnd，Message.Msg，Message.WParam，Message.LParam）; 
结尾； 
 
过程TWndThread.HandleAction1; 
开始
 // 
结束； 
 
过程TWndThread.HandleCopyData（const Cds：TCopyDataStruct）; 
 var 
 S：字符串；如果Cds.cbData> 
从
开始0然后
开始
 SetLength（S，Cds.cbData div SizeOf（Char））; 
 CopyMemory（Pointer（S），Cds.lpData，Length（S）* SizeOf（Char））; 
结尾； 
 //根据需要使用S ... 
结尾； 
 
初始化
 MY_CDS_VALUE：= RegisterWindowMessage（’MY_CDS_VALUE’）; 
 
结尾。


I'm trying (in D7) to set up a thread with a message pump, which eventually I want to transplant into a DLL.

Here's the relevant/non-trivial parts of my code:

const
  WM_Action1 = WM_User + 1;
  scThreadClassName = 'MyThreadClass';

type
  TThreadCreatorForm = class;

  TWndThread = class(TThread)
  private
    FTitle: String;
    FWnd: HWND;
    FWndClass: WNDCLASS;
    FCreator : TForm;
    procedure HandleAction1;
  protected
    procedure Execute; override;
  public
    constructor Create(ACreator: TForm; const Title: String); 
  end;

  TThreadCreatorForm = class(TForm)
    btnCreate: TButton;
    btnAction1: TButton;
    Label1: TLabel;
    btnQuit: TButton;
    btnSend: TButton;
    edSend: TEdit;
    procedure FormShow(Sender: TObject);
    procedure btnCreateClick(Sender: TObject);
    procedure btnAction1Click(Sender: TObject);
    procedure btnQuitClick(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure WMAction1(var Msg : TMsg); message WM_Action1;
    procedure FormCreate(Sender: TObject);
  public
    { Public declarations }
    WndThread : TWndThread;
    ThreadID : Integer;
    ThreadHWnd : HWnd;
  end;

var
  ThreadCreatorForm: TThreadCreatorForm;

implementation

{$R *.DFM}

procedure SendStringViaWMCopyData(HSource, HDest : THandle; const AString : String);
var
  Cds : TCopyDataStruct;
  Res : Integer;
begin
  FillChar(Cds, SizeOf(Cds), 0);
  GetMem(Cds.lpData, Length(Astring) + 1);
  try
    StrCopy(Cds.lpData, PChar(AString));
    Res := SendMessage(HDest, WM_COPYDATA, HSource, Cardinal(@Cds));
    ShowMessage(IntToStr(Res));
  finally
    FreeMem(Cds.lpData);
  end;
end;

procedure TThreadCreatorForm.FormShow(Sender: TObject);
begin
  ThreadID := GetWindowThreadProcessId(Self.Handle, Nil);
  Assert(ThreadID = MainThreadID);
end;

procedure TWndThread.HandleAction1;
begin
  //
end;

constructor TWndThread.Create(ACreator: TForm; const Title:String);
begin
  inherited Create(True);
  FTitle := Title;
  FCreator := ACreator;
  FillChar(FWndClass, SizeOf(FWndClass), 0);
  FWndClass.lpfnWndProc := @DefWindowProc;
  FWndClass.hInstance := HInstance;
  FWndClass.lpszClassName := scThreadClassName;
end;

procedure TWndThread.Execute;
var
  Msg: TMsg;
  Done : Boolean;
  S : String;
begin
  if Windows.RegisterClass(FWndClass) = 0 then Exit;
  FWnd := CreateWindow(FWndClass.lpszClassName, PChar(FTitle), WS_DLGFRAME, 0, 0, 0, 0, 0, 0, HInstance, nil);
  if FWnd = 0 then Exit;

  Done := False;
  while GetMessage(Msg, 0, 0, 0) and not done do begin
    case Msg.message of
      WM_Action1 : begin
        HandleAction1;
      end;
      WM_COPYDATA : begin
        Assert(True);
      end;
      WM_Quit : Done := True;
      else begin
        TranslateMessage(msg);
        DispatchMessage(msg)
      end;
    end; { case }
  end;
  if FWnd <> 0 then
    DestroyWindow(FWnd);
  Windows.UnregisterClass(FWndClass.lpszClassName, FWndClass.hInstance);
end;

Once I've created the thread, I find its window handle using FindWindow and that works fine.

If I PostMessage it my user-defined WM_Action1 message, it's received by the GetMessage(), and caught by the case statement in the thread's Execute, and that works fine.

If I send myself (i.e. my host form) a WM_CopyData message using the SendStringViaWMCopyData() routine that works fine.

However: If I send my thread the WM_CopyData message, the GetMessage and case statement in Execute never see it and the SendMessage in SendStringViaWMCopyData returns 0.

So, my question is, why does the WM_CopyData message not get received by the GetMessage in .Execute? I have an uncomfortable feeling I'm missing something ...

解决方案

WM_COPYDATA is not a posted message, it is a sent message, so it does not go through the message queue and thus a message loop will never see it. You need to assign a window procedure to your window class and process WM_COPYDATA in that procedure instead. Don't use DefWindowProc() as your window procedure.

Also, when sending WM_COPYDATA, the lpData field is expressed in bytes not in characters, so you need to take that in to account. And you are not filling in the COPYDATASTRUCT correctly. You need to provide values for the dwData and cbData fields. And you don't need to allocate memory for the lpData field, you can point it to your String's existing memory instead.

Try this:

const
  WM_Action1 = WM_User + 1;
  scThreadClassName = 'MyThreadClass';

type
  TThreadCreatorForm = class;

  TWndThread = class(TThread)
  private
    FTitle: String;
    FWnd: HWND;
    FWndClass: WNDCLASS;
    FCreator : TForm;
    procedure WndProc(var Message: TMessage);
    procedure HandleAction1;
    procedure HandleCopyData(const Cds: TCopyDataStruct);
  protected
    procedure Execute; override;
    procedure DoTerminate; override;
  public
    constructor Create(ACreator: TForm; const Title: String); 
  end;

  TThreadCreatorForm = class(TForm)
    btnCreate: TButton;
    btnAction1: TButton;
    Label1: TLabel;
    btnQuit: TButton;
    btnSend: TButton;
    edSend: TEdit;
    procedure FormShow(Sender: TObject);
    procedure btnCreateClick(Sender: TObject);
    procedure btnAction1Click(Sender: TObject);
    procedure btnQuitClick(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure WMAction1(var Msg : TMsg); message WM_Action1;
    procedure FormCreate(Sender: TObject);
  public
    { Public declarations }
    WndThread : TWndThread;
    ThreadID : Integer;
    ThreadHWnd : HWnd;
  end;

var
  ThreadCreatorForm: TThreadCreatorForm;

implementation

{$R *.DFM}

var
  MY_CDS_VALUE: UINT = 0;

procedure SendStringViaWMCopyData(HSource, HDest : HWND; const AString : String);
var
  Cds : TCopyDataStruct;
  Res : Integer;
begin
  ZeroMemory(@Cds, SizeOf(Cds));
  Cds.dwData := MY_CDS_VALUE;
  Cds.cbData := Length(AString) * SizeOf(Char);
  Cds.lpData := PChar(AString);
  Res := SendMessage(HDest, WM_COPYDATA, HSource, LPARAM(@Cds));
  ShowMessage(IntToStr(Res));
end;

procedure TThreadCreatorForm.FormShow(Sender: TObject);
begin
  ThreadID := GetWindowThreadProcessId(Self.Handle, Nil);
  Assert(ThreadID = MainThreadID);
end;

function TWndThreadWindowProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  pSelf: TWndThread;
  Message: TMessage;
begin
  pSelf := TWndThread(GetWindowLongPtr(hWnd, GWL_USERDATA));
  if pSelf <> nil then
  begin
    Message.Msg := uMsg;
    Message.WParam := wParam;
    Message.LParam := lParam;
    Message.Result := 0;
    pSelf.WndProc(Message);
    Result := Message.Result;
  end else
    Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
end;

constructor TWndThread.Create(ACreator: TForm; const Title:String);
begin
  inherited Create(True);
  FTitle := Title;
  FCreator := ACreator;
  FillChar(FWndClass, SizeOf(FWndClass), 0);
  FWndClass.lpfnWndProc := @TWndThreadWindowProc;
  FWndClass.hInstance := HInstance;
  FWndClass.lpszClassName := scThreadClassName;
end;

procedure TWndThread.Execute;
var
  Msg: TMsg;
begin
  if Windows.RegisterClass(FWndClass) = 0 then Exit;
  FWnd := CreateWindow(FWndClass.lpszClassName, PChar(FTitle), WS_DLGFRAME, 0, 0, 0, 0, 0, 0, HInstance, nil);
  if FWnd = 0 then Exit;
  SetWindowLongPtr(FWnd, GWL_USERDATA, ULONG_PTR(Self));

  while GetMessage(Msg, 0, 0, 0) and (not Terminated) do
  begin
    TranslateMessage(msg);
    DispatchMessage(msg);
  end;
end;

procedure TWndThread.DoTerminate;
begin
  if FWnd <> 0 then
    DestroyWindow(FWnd);
  Windows.UnregisterClass(FWndClass.lpszClassName, FWndClass.hInstance);
  inherited;
end;

procedure TWndThread.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_Action1 : begin
      HandleAction1;
      Exit;
    end;
    WM_COPYDATA : begin
      if PCopyDataStruct(lParam).dwData = MY_CDS_VALUE then
      begin
        HandleCopyData(PCopyDataStruct(lParam)^);
        Exit;
      end;
    end; 
  end;

  Message.Result := DefWindowProc(FWnd, Message.Msg, Message.WParam, Message.LParam);
end;

procedure TWndThread.HandleAction1;
begin
  //
end;

procedure TWndThread.HandleCopyData(const Cds: TCopyDataStruct);
var
  S: String;
begin
  if Cds.cbData > 0 then
  begin
    SetLength(S, Cds.cbData div SizeOf(Char));
    CopyMemory(Pointer(S), Cds.lpData, Length(S) * SizeOf(Char));
  end;
  // use S as needed...
end;

initialization
  MY_CDS_VALUE := RegisterWindowMessage('MY_CDS_VALUE');

end.

这篇关于Delphi-线程中的消息泵未接收到WM_COPYDATA消息的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文
相关文章
其他开发最新文章
热门教程
热门工具
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆