logo标签列表

如何终止一个线程？

multithreadingdelphi
4

我的通常线程设置是一个 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 //
2
我们不知道inherited Destroy中有什么，所以很难说。但作为一般惯例，不应该使用Suspend和Resume。最好使用同步对象（尝试使用SyncObjs.TSimpleEvent），并让您的线程在其上等待。 - Mason Wheeler
1
'FreeOnTerminate' 设置为什么？ - Martin James
你到底为什么在终止后又恢复执行？ - Warren P
2
@Warren，你还能怎么保证程序运行到完成呢？ - David Heffernan
1
阿诺德，有点是这样的。你析构函数中的代码确实是多余的，但这并不意味着 inherited Destroy 会让事情变得更好。由于它执行与你的析构函数相同的所有操作，你仍然会受到相同的竞态条件的影响。（此外，如果一个方法——即使是析构函数——除了调用继承的方法之外什么也不做，你根本不需要编写任何内容；完全省略派生类方法。） - Rob Kennedy
显示剩余5条评论
4个回答
4

您真的不应该像这样使用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;
非常感谢您的回答！我一直在寻找避免挂起/恢复的方法，但是没有找到。我会实现这段代码并看看它的效果如何。 - Arnold
它可以在XP和7上运行！感谢这个示例代码，因为它是Suspend/Resume语句的一个很好的替代品。它还是我在代码中经常使用的通用循环线程的大纲。 - Arnold
3

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

我猜你有一个像下面这样的方法:

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

如果你在线程处于(1)或(2)附近调用DoWork并恢复线程，它将立即返回挂起状态。

如果你在执行到(2)时调用Destroy，它将立即挂起并很可能永远无法终止。

1
它包含'Application.ProcessMessages'、'Suspend'、'Resume'和'TThread.WaitFor'。在我看来，这是四个bug，尽管我认识到其他人可能有不同的看法。我们都知道暂停/恢复线程控制是危险的。'TThread.WaitFor'像'Join'一样是一个生成关闭死锁的工具，而A.P几乎总是一个糟糕设计的指标或者实际上是毫无意义的。 - Martin James
@martin，WaitFor或join有什么问题吗？不使用它们会使同步变得棘手。 - David Heffernan
@DavidHeffernan - 只是棘手？我希望是“不可能的”。你可能已经猜到了，我更喜欢消息传递。我不确定哪个更大，那些试图关闭应用程序的巨大补丁或因不断创建/销毁线程而导致性能不佳的应用程序数量。请注意，我不会因为他/她的问题而责怪OP-当D3推出时，Delphi示例就很糟糕，我认为它们并没有改进。结果-几十年的次优设计，例如suspend/resume控件-直接从Delphi示例中获取。 - Martin James
2
Arnold，如果你的解决方案是为每个新事件创建一个新线程，那么你应该考虑使用线程池。操作系统提供了一个，一些Delphi线程库也有线程池。这允许你的程序继续触发不同的事件，但消除了创建和销毁大量操作系统线程的开销。线程池确保空闲线程得到重复使用。 - Rob Kennedy
我错过了线程池的这个备注。我会去看一下的。谢谢你提出来。 - Arnold
显示剩余2条评论
2

这段代码存在死锁的潜在风险。假设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；因为它不是虚拟的，所以对于执行任何非平凡操作的线程来说，它只是一个无用的终止方法。）

感谢您清楚地指出了竞态条件。我会在一个示例程序中尝试您的建议，它似乎是解决问题的方案。非常感谢！ - Arnold
-1
尝试使用 "suspended := false" 代替 "resume"。
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接