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

标签 multithreading delphi wm-copydata

我正在尝试(在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找到它的窗口句柄，并且可以正常工作。

如果我将PostPost消息作为用户定义的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: 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.

关于multithreading - Delphi-线程中的消息泵未接收到WM_COPYDATA消息，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/25432761/

上一篇：delphi - 将 TStringList 更改为 TStrings 时出现抽象错误

下一篇：delphi - 防止类型转换可以揭示隐藏的属性？

相关文章：

c# - 用于处理 Windows 消息队列的多线程 Windows 服务

delphi - 从 DLL 的映射文件中获取源行号

delphi - 如何关闭/打开整个 Delphi 项目的 WARN 指令？

Delphi跟踪工具

python - 如何使用线程并行压缩迭代器？

c# - 在 C# 窗体关闭时替代异步/等待，因为等待永远不会返回？

c++ - 在带有WM_COPYDATA消息的结构中使用LPCTSTR是否安全？

delphi 通过 wm_copydata 将运行参数传递给其他实例在 Delphi XE2 中给出错误结果

vb.net - 如何将短字符串从Visual Basic应用程序发送到Delphi应用程序？

c# - Wait Handles 是否释放线程获取的锁？

©2024 IT工具网  联系我们