Delphi - Message pump in thread not receiving WM_COPYDATA messages

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

Solution

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.