multithreading - 将消息发送到由AllocateHWND创建的窗口导致死锁

Question

在我的Delphi项目中，我派生了一个线程类TMyThread，并按照论坛的建议使用AllocateHWnd创建窗口句柄。在TMyThread对象中，我调用SendMessage将消息发送到窗口句柄。

当发送的消息量很小时，该应用程序将运行良好。但是，当消息量很大时，应用程序将死锁并丢失响应。我认为可能是消息队列已满，就像在LogWndProc中一样，只有代码可以处理消息，但是没有代码可以从队列中删除消息，这可能导致所有已处理的消息仍然存在于队列中，并且队列已满。那是对的吗？

代码附在下面:

var
hLogWnd: HWND = 0;

procedure TForm1.FormCreate(Sender: TObject);
begin
hLogWnd := AllocateHWnd(LogWndProc);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if hLogWnd <> 0 then
DeallocateHWnd(hLogWnd);
end;

procedure TForm1.LogWndProc(var Message: TMessage);
var
S: PString;
begin
if Message.Msg = WM_UPDATEDATA then
begin
S := PString(msg.LParam);
try
List1.Items.Add(S^);
finally
Dispose(S);
end;
end else
Message.Result := DefWindowProc(hLogWnd, Message.Msg, Message.WParam,
Message.LParam);
end;

procedure TMyThread.SendLog(I: Integer);
var
Log: PString;
begin
New(Log);
Log^ := 'Log: current stag is ' + IntToStr(I);
SendMessage(hLogWnd, WM_UPDATEDATA, 0, LPARAM(Log));
Dispose(Log);
end;

Answer 1

您将分配的字符串处理两次。最好的情况是，在SendMessage()退出后，您的工作线程中将获得一个异常，如果您没有捕获到该异常，则终止您的线程。更糟糕的是，您可能不会遇到异常，但会浪费内存，使应用程序处于不良状态，因此各种随机事件都可能发生。您只需要处置分配的字符串一次。

您不负责从队列中删除已发送的消息，因为o​​jit_code不会将消息放入队列中。但是，它确实需要接收线程为新消息泵送其队列，即使队列中没有新消息，也可以像线程消息一样发送跨越线程边界的已发送消息。如果SendMessage()正在阻止，则您的主线程未使用未显示的代码正确地泵送队列，例如，如果您有其他代码阻止了主消息循环的运行。

至于您显示的代码，我建议进行以下更改:

procedure TForm1.LogWndProc(var Message: TMessage);
begin
  if Message.Msg = WM_UPDATEDATA then
    List1.Items.Add(PString(Message.LParam)^)
  else
    Message.Result := DefWindowProc(hLogWnd, Message.Msg, Message.WParam, Message.LParam);
end;

procedure TMyThread.SendLog(I: Integer);
var
  Log: String;
begin
  Log := 'Log: current stag is ' + IntToStr(I);
  SendMessage(hLogWnd, WM_UPDATEDATA, 0, LPARAM(@Log));
end;

如果使用 SendMessage()，则不需要动态分配字符串，因为它会阻塞调用线程，直到处理完消息为止，从而确保字符串仍然有效。如果您使用的是 SendMessage()，则需要动态分配(并修复 PostMessage()的错误使用):

procedure TForm1.LogWndProc(var Message: TMessage);
var
  S: PString;
begin
  if Message.Msg = WM_UPDATEDATA then
  begin
    S := PString(msg.LParam);
    try
      List1.Items.Add(S^);
    finally
      Dispose(S);
    end;
  end else
    Message.Result := DefWindowProc(hLogWnd, Message.Msg, Message.WParam, Message.LParam);
end;

procedure TMyThread.SendLog(I: Integer);
var
  Log: PString;
begin
  New(Log);
  Log^ := 'Log: current stag is ' + IntToStr(I);
  if not PostMessage(hLogWnd, WM_UPDATEDATA, 0, LPARAM(Log)) then
    Dispose(Log);
end;