Delphi - 线程中的消息泵未接收WM_COPYDATA消息

Question

我正在尝试(在D7中)设置一个带有消息泵的线程,最终我想将其移植到DLL中.

这是我的代码的相关/非平凡部分:

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;

一旦我创建了线程,我就会使用FindWindow找到它的窗口句柄,并且工作正常.

如果我PostMessage它是我的用户定义的WM_Action1消息,它由GetMessage()接收,并被线程的Execute中的case语句捕获,并且工作正常.

如果我使用SendStringViaWMCopyData()例程发送自己(即我的主机表单)WM_CopyData消息,该例程工作正常.

但是:如果我向我的线程发送WM_CopyData消息,则Execute中的GetMessage和case语句永远不会看到它,并且SendStringViaWMCopyData中的SendMessage将返回0.

所以,我的问题是,为什么.Mecute中的GetMessage没有收到WM_CopyData消息？我有一种不舒服的感觉我错过了一些东西......

Answer 1

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: 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.