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）附近恢复线程，它将立即恢复暂停。

如果你在执行时遇到Destroy（2），它会立即暂停，很可能永远不会终止。

Answer 3

该代码肯定存在死锁潜力。假设Execute和Destroy同时运行，并且在评估Execute之后立即切换到not Terminated线程，如下所示：

// 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

尝试使用suspended：= false而不是resume。

如何终止一个线程？

4 个答案: