如何终止一个线程？

Question

我通常的线程设置是一个while循环，在while循环内做两件事：

• 做一些工作
• 暂停，直到从外部恢复

procedure TMIDI_Container_Publisher.Execute;
begin
   Suspend;
   while not Terminated do
   begin
      FContainer.Publish;
      if not Terminated then Suspend;
   end; // if
end; // Execute //

这很好用。终止我使用的代码：

destructor TMIDI_Container_Publisher.Destroy;
begin
   Terminate;
   if Suspended then Resume;
   Application.ProcessMessages;
   Self.WaitFor;

   inherited Destroy;
end; // Destroy //

此 Destroy 在 Windows 7 中运行良好，但在 XP 中挂起。问题似乎是 WaitFor 但是当我删除它时，代码挂在 inherited Destroy 中。

有人知道怎么回事吗？

---

2011/11/02 更新 感谢大家的帮助。 Remy Labeau 附带了一个代码示例来完全避免 Resume/Suspend。从现在开始，我将在我的程序中实施他的建议。对于这个具体案例，我受到 CodeInChaos 建议的启发。只需创建一个线程，让它在 Execute 中发布并忘记它。我用 Remy 的例子重写了我的一个计时器。我在下面发布了这个实现。

unit Timer_Threaded;

interface

uses Windows, MMSystem, Messages, SysUtils, Classes, Graphics, Controls, Forms,
     Dialogs, SyncObjs,
     Timer_Base;

Type
   TTask = class (TThread)
   private
      FTimeEvent: TEvent;
      FStopEvent: TEvent;
      FOnTimer: TNotifyEvent;

   public
      constructor Create;
      destructor Destroy; override;
      procedure Execute; override;
      procedure Stop;
      procedure ProcessTimedEvent;

      property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
   end; // Class: TWork //

   TThreadedTimer = class (TBaseTimer)
   private
      nID: cardinal;
      FTask: TTask;

   protected
      procedure SetOnTimer (Task: TNotifyEvent); override;

      procedure StartTimer; override;
      procedure StopTimer; override;

   public
      constructor Create; override;
      destructor Destroy; override;
   end; // Class: TThreadedTimer //

implementation

var SelfRef: TTask; // Reference to the instantiation of this timer

procedure TimerUpdate (uTimerID, uMessage: cardinal; dwUser, dw1, dw2: cardinal); stdcall;
begin
   SelfRef.ProcessTimedEvent;
end; // TimerUpdate //

{*******************************************************************
*                                                                  *
* Class TTask                                                      *
*                                                                  *
********************************************************************}

constructor TTask.Create;
begin
   FTimeEvent := TEvent.Create (nil, False, False, '');
   FStopEvent := TEvent.Create (nil, True,  False, '');

   inherited Create (False);

   Self.Priority := tpTimeCritical;
end; // Create //

destructor TTask.Destroy;
begin
   Stop;
   FTimeEvent.Free;
   FStopEvent.Free;

   inherited Destroy;
end; // Destroy //

procedure TTask.Execute;
var two: TWOHandleArray;
    h:   PWOHandleArray;
    ret: DWORD;
begin
   h := @two;
   h [0] := FTimeEvent.Handle;
   h [1] := FStopEvent.Handle;

   while not Terminated do
   begin
      ret := WaitForMultipleObjects (2, h, FALSE, INFINITE);
      if ret = WAIT_FAILED then Break;
      case ret of
         WAIT_OBJECT_0 + 0: if Assigned (OnTimer) then OnTimer (Self);
         WAIT_OBJECT_0 + 1: Terminate;
      end; // case
   end; // while
end; // Execute //

procedure TTask.ProcessTimedEvent;
begin
   FTimeEvent.SetEvent;
end; // ProcessTimedEvent //

procedure TTask.Stop;
begin
   Terminate;
   FStopEvent.SetEvent;
   WaitFor;
end; // Stop //

{*******************************************************************
*                                                                  *
* Class TThreaded_Timer                                            *
*                                                                  *
********************************************************************}

constructor TThreadedTimer.Create;
begin
   inherited Create;

   FTask := TTask.Create;
   SelfRef := FTask;
   FTimerName := 'Threaded';
   Resolution := 2;
end; // Create //

// Stop the timer and exit the Execute loop
Destructor TThreadedTimer.Destroy;
begin
   Enabled := False;  // stop timer (when running)
   FTask.Free;

   inherited Destroy;
end; // Destroy //

procedure TThreadedTimer.SetOnTimer (Task: TNotifyEvent);
begin
   inherited SetOnTimer (Task);

   FTask.OnTimer := Task;
end; // SetOnTimer //

// Start timer, set resolution of timesetevent as high as possible (=0)
// Relocates as many resources to run as precisely as possible
procedure TThreadedTimer.StartTimer;
begin
   nID := TimeSetEvent (FInterval, FResolution, TimerUpdate, cardinal (Self), TIME_PERIODIC);
   if nID = 0 then
   begin
      FEnabled := False;
      raise ETimer.Create ('Cannot start TThreaded_Timer');
   end; // if
end; // StartTimer //

// Kill the system timer
procedure TThreadedTimer.StopTimer;
var return: integer;
begin
   if nID <> 0 then
   begin
      return := TimeKillEvent (nID);
      if return <> TIMERR_NOERROR
         then raise ETimer.CreateFmt ('Cannot stop TThreaded_Timer: %d', [return]);
   end; // if
end; // StopTimer //

end. // Unit: MSC_Threaded_Timer //


unit Timer_Base;

interface

uses
  Windows, MMSystem, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs;

type
   TCallBack = procedure (uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD);

   ETimer = class (Exception);

{$M+}
   TBaseTimer = class (TObject)
   protected
      FTimerName: string;     // Name of the timer
      FEnabled: boolean;      // True= timer is running, False = not
      FInterval: Cardinal;    // Interval of timer in ms
      FResolution: Cardinal;  // Resolution of timer in ms
      FOnTimer: TNotifyEvent; // What to do when the hour (ms) strikes

      procedure SetEnabled (value: boolean); virtual;
      procedure SetInterval (value: Cardinal); virtual;
      procedure SetResolution (value: Cardinal); virtual;
      procedure SetOnTimer (Task: TNotifyEvent); virtual;

   protected
      procedure StartTimer; virtual; abstract;
      procedure StopTimer; virtual; abstract;

   public
      constructor Create; virtual;
      destructor Destroy; override;

   published
      property TimerName: string read FTimerName;
      property Enabled: boolean read FEnabled write SetEnabled;
      property Interval: Cardinal read FInterval write SetInterval;
      property Resolution: Cardinal read FResolution write SetResolution;
      property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
   end; // Class: HiResTimer //

implementation

constructor TBaseTimer.Create;
begin
   inherited Create;

   FEnabled    := False;
   FInterval   := 500;
   Fresolution := 10;
end; // Create //

destructor TBaseTimer.Destroy;
begin
   inherited Destroy;
end; // Destroy //

// SetEnabled calls StartTimer when value = true, else StopTimer
// It only does so when value is not equal to the current value of FEnabled
// Some Timers require a matching StartTimer and StopTimer sequence
procedure TBaseTimer.SetEnabled (value: boolean);
begin
   if value <> FEnabled then
   begin
      FEnabled := value;
      if value
         then StartTimer
         else StopTimer;
   end; // if
end; // SetEnabled //

procedure TBaseTimer.SetInterval (value: Cardinal);
begin
   FInterval := value;
end; // SetInterval //

procedure TBaseTimer.SetResolution (value: Cardinal);
begin
   FResolution := value;
end; // SetResolution //

procedure TBaseTimer.SetOnTimer (Task: TNotifyEvent);
begin
   FOnTimer := Task;
end; // SetOnTimer //

end. // Unit: MSC_Timer_Custom //

Answer 1

你真的不应该像这样使用Suspend() 和Resume()。它们不仅在滥用时很危险（就像你一样），而且无论如何它们在 D2010+ 中也被弃用了。更安全的替代方法是改用TEvent 类，例如：

contructor TMIDI_Container_Publisher.Create;
begin
  fPublishEvent := TEvent.Create(nil, False, False, '');
  fTerminateEvent := TEvent.Create(nil, True, False, '');
  inherited Create(False);
end;

destructor TMIDI_Container_Publisher.Destroy;
begin
  Stop
  fPublishEvent.Free;
  fTerminateEvent.Free;
  inherited Destroy;
end;

procedure TMIDI_Container_Publisher.Execute;
var
  h: array[0..1] of THandle;
  ret: DWORD;
begin
  h[0] := fPublishEvent.Handle;
  h[1] := fTerminateEvent.Handle;

  while not Terminated do
  begin
    ret := WaitForMultipleObjects(2, h, FALSE, INFINITE);
    if ret = WAIT_FAILED then Break;
    case ret of
      WAIT_OBJECT_0 + 0: FContainer.Publish;
      WAIT_OBJECT_0 + 1: Terminate;
    end;
  end;
end;

procedure TMIDI_Container_Publisher.Publish;
begin
  fPublishEvent.SetEvent;
end;

procedure TMIDI_Container_Publisher.Stop;
begin
  Terminate;
  fTerminateEvent.SetEvent;
  WaitFor;
end;

Answer 2

我不知道你的问题的答案，但我认为你的代码至少还有一个错误：

我猜你有如下方法：

procedure DoWork()
begin
  AddWork();
  Resume();
end;

这会导致竞争条件：

procedure TMIDI_Container_Publisher.Execute;
begin
   Suspend;
   while not Terminated do
   begin
      FContainer.Publish;
      // <= Assume code is here (1)
      if not Terminated then { Or even worse: here (2) } Suspend;
   end; // if
end; // Execute //

如果您调用 DoWork 并在线程处于 (1) 或 (2) 附近时恢复线程，它将立即恢复暂停。

如果您在执行 (2) 左右时调用 Destroy，它将立即暂停并且很可能永远不会终止。

Answer 3

该代码中肯定存在死锁的可能性。假设Execute 和Destroy 正在同时运行，并且在评估not Terminated 后立即从Execute 线程发生上下文切换，如下所示：

// Thread 1                      // Thread 2
if not Terminated then
                // context switch
                                 Terminate;
                                 if Suspended then Resume;
                                 Application.ProcessMessages;
                                 WaitFor;
                // context switch
  Suspend;

现在您正在等待暂停线程的终止。那永远不会取得进展。继承的析构函数还调用Terminate 和WaitFor，因此从您自己的析构函数中删除代码不会对您程序的行为产生太大影响也就不足为奇了。

不要挂起线程。相反，让它等待一个表明有更多数据需要处理的事件。同时，让它等待另一个事件来发出线程应该终止的信号。 （作为该建议的扩展，不要打扰调用Terminate；因为它不是虚拟的，所以它不是终止执行任何非平凡线程的有用方法。）

Answer 4

尝试使用 suspend := false 而不是 resume。