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()退出后，您将在工作线程中获得异常，如果您没有捕获该异常，则终止您的线程。更糟糕的是，你可能没有异常，但是你会丢弃内存，让你的应用程序处于不良状态，因此会发生各种各样的随机事件。您只需要处理分配的字符串一次。

您不负责从队列中删除已发送的邮件，因为SendMessage()未将邮件放入队列。但是，它确实需要接收线程为新消息抽取其队列，即使队列中没有新消息，以便分派正在跨越线程边界的已发送消息，就像您的消息一样。如果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()，则无需动态分配字符串，因为它会阻止调用线程直到处理消息，从而确保字符串保持有效。如果您使用的是PostMessage()，那么您需要动态分配（并修复错误地使用Dispose()）：

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;

SendMessage到AllocateHWND创建的窗口导致死锁

1 个答案: