gpt4 book ai didi

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

转载 作者:行者123 更新时间:2023-12-03 18:56:22 27 4
gpt4 key购买 nike

我正在尝试(在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。您需要为dwDatacbData字段提供值。而且您不需要为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/

27 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com