Delphi线程死锁

thread1.terminate;
thread1.waitfor;
thread1.free;

记录消息只是Synchronize()完全没有任何意义的区域之一.您应该创建一个日志目标对象,该对象具有一个字符串列表,受关键部分的保护,并添加您的日志消息.让主VCL线程从该列表中删除日志消息,并将其显示在日志窗口中.这有几个优点：

>你不需要调用Synchronize(),这只是一个坏主意.好的副作用是你的关机问题消失了.
>工作线程可以继续他们的工作,而不会阻塞主线程事件处理,或者在尝试记录消息的其他线程上.
>性能提高,因为一次可以将多条消息添加到日志窗口.如果您使用BeginUpdate()和EndUpdate()这将加快速度.

没有任何缺点,我可以看到 – 日志消息的顺序也保留下来.

编辑：

我将添加一些更多的信息和一些代码来玩,以便说明有更好的方法来做你需要做的事情.

从与VCL程序中的主应用程序线程不同的线程调用Synchronize()将导致调用线程阻塞,所传递的代码将在VCL线程的上下文中执行,然后调用线程将被解除阻塞并继续跑.在单处理器机器的时代,这可能是一个好主意,只有一个线程可以一次运行,但是使用多个处理器或内核,这是一个巨大的浪费,应该不惜一切代价避免.如果在8核心机器上有8个工作线程,调用Synchronize()可能会将吞吐量限制在可能的一小部分.

实际上,调用Synchronize()并不是一个好主意,因为它可能导致死锁.有一个更有说服力的理由,不要使用它.

使用PostMessage()发送日志消息将会处理死锁问题,但它有自己的问题：

>每个日志字符串将导致一个消息被发布和处理,导致很多开销.一次无法处理多个日志消息.
> Windows消息只能在参数中携带机器字大小的数据.因此发送字符串是不可能的.在类型转换到PChar后发送字符串是不安全的,因为字符串可能在消息被处理时被释放.在处理消息后,在工作线程中分配内存并释放VCL线程中的内存是一种出路.一种增加更多开销的方式.
> Windows中的消息队列具有有限的大小.发布太多邮件可能导致队列变满,邮件被删除.这不是一件好事,并且与之前的一切导致内存泄漏.
>在生成任何定时器或油漆消息之前,将处理队列中的所有消息.因此,许多发布消息的稳定流可能导致程序无响应.

收集日志消息的数据结构可能如下所示：

type
  TLogTarget = class(TObject)
  private
    fCritSect: TCriticalSection;
    fMsgs: TStrings;
  public
    constructor Create;
    destructor Destroy; override;

    procedure GetLoggedMsgs(AMsgs: TStrings);
    procedure LogMessage(const AMsg: string);
  end;

constructor TLogTarget.Create;
begin
  inherited;
  fCritSect := TCriticalSection.Create;
  fMsgs := TStringList.Create;
end;

destructor TLogTarget.Destroy;
begin
  fMsgs.Free;
  fCritSect.Free;
  inherited;
end;

procedure TLogTarget.GetLoggedMsgs(AMsgs: TStrings);
begin
  if AMsgs <> nil then begin
    fCritSect.Enter;
    try
      AMsgs.Assign(fMsgs);
      fMsgs.Clear;
    finally
      fCritSect.Leave;
    end;
  end;
end;

procedure TLogTarget.LogMessage(const AMsg: string);
begin
  fCritSect.Enter;
  try
    fMsgs.Add(AMsg);
  finally
    fCritSect.Leave;
  end;
end;

许多线程可以同时调用LogMessage(),进入关键部分将序列化对列表的访问,并且在添加他们的消息之后,线程可以继续他们的工作.

这就是VCL线程知道何时调用GetLoggedMsgs()来从对象中删除消息并将它们添加到窗口的问题.一个穷人的版本将是一个定时器和民意调查.更好的方法是在添加日志消息时调用PostMessage()：

procedure TLogTarget.LogMessage(const AMsg: string);
begin
  fCritSect.Enter;
  try
    fMsgs.Add(AMsg);
    PostMessage(fNotificationHandle,WM_USER,0);
  finally
    fCritSect.Leave;
  end;
end;

这仍然发生太多邮件的问题.只有当前一个消息处理完毕时,才需要发布消息：

procedure TLogTarget.LogMessage(const AMsg: string);
begin
  fCritSect.Enter;
  try
    fMsgs.Add(AMsg);
    if InterlockedExchange(fMessagePosted,1) = 0 then
      PostMessage(fNotificationHandle,0);
  finally
    fCritSect.Leave;
  end;
end;

然而,仍然可以改进.使用定时器解决了发布的消息填满队列的问题.以下是实现这一点的小类：

type
  TMainThreadNotification = class(TObject)
  private
    fNotificationMsg: Cardinal;
    fNotificationRequest: integer;
    fNotificationWnd: HWND;
    fOnNotify: TNotifyEvent;
    procedure DoNotify;
    procedure NotificationWndMethod(var AMsg: TMessage);
  public
    constructor Create;
    destructor Destroy; override;

    procedure RequestNotification;
  public
    property OnNotify: TNotifyEvent read fOnNotify write fOnNotify;
  end;

constructor TMainThreadNotification.Create;
begin
  inherited Create;
  fNotificationMsg := RegisterWindowMessage('thrd_notification_msg');
  fNotificationRequest := -1;
  fNotificationWnd := AllocateHWnd(NotificationWndMethod);
end;

destructor TMainThreadNotification.Destroy;
begin
  if IsWindow(fNotificationWnd) then
    DeallocateHWnd(fNotificationWnd);
  inherited Destroy;
end;

procedure TMainThreadNotification.DoNotify;
begin
  if Assigned(fOnNotify) then
    fOnNotify(Self);
end;

procedure TMainThreadNotification.NotificationWndMethod(var AMsg: TMessage);
begin
  if AMsg.Msg = fNotificationMsg then begin
    SetTimer(fNotificationWnd,42,10,nil);
    // set to 0,so no new message will be posted
    InterlockedExchange(fNotificationRequest,0);
    DoNotify;
    AMsg.Result := 1;
  end else if AMsg.Msg = WM_TIMER then begin
    if InterlockedExchange(fNotificationRequest,0) = 0 then begin
      // set to -1,so new message can be posted
      InterlockedExchange(fNotificationRequest,-1);
      // and kill timer
      KillTimer(fNotificationWnd,42);
    end else begin
      // new notifications have been requested - keep timer enabled
      DoNotify;
    end;
    AMsg.Result := 1;
  end else begin
    with AMsg do
      Result := DefWindowProc(fNotificationWnd,Msg,WParam,LParam);
  end;
end;

procedure TMainThreadNotification.RequestNotification;
begin
  if IsWindow(fNotificationWnd) then begin
    if InterlockedIncrement(fNotificationRequest) = 0 then
     PostMessage(fNotificationWnd,fNotificationMsg,0);
  end;
end;

该类的一个实例可以添加到TLogTarget,以在主线程中调用通知事件,但每秒钟最多打几次.