我应该用什么 delphi 代码替换对已弃用的 TThread 方法 Suspend 的调用？

Question

以前有人问过，但是without a full answer。这与所谓的著名的“‘致命线程模型！’”有关。

我需要用安全的东西替换对 TThread.Suspend 的调用，它会在终止或恢复时返回：

procedure TMyThread.Execute;
begin
  while (not Terminated) do begin
     if PendingOffline then begin
          PendingOffline := false;   // flag off.
          ReleaseResources;
          Self.Suspend; // suspend thread. { evil! ask Barry Kelly why.}
          // -- somewhere else, after a long time, a user clicks
          // a resume button, and the thread resumes: --
          if Terminated then
              exit; // leave TThread.Execute.
          // Not terminated, so we continue..
          GrabResources;
     end;
    end;
end;

原始答案含糊地暗示“TMutex、TEvent 和临界区”。

我想我正在寻找 TThreadThatDoesntSuck。

这是用于 cmets 的带有 Win32Event 的 TThread 派生示例：

unit SignalThreadUnit;

interface

uses
  Classes,SysUtils,Windows;

type

TSignalThread = class(TThread)
  protected
    FEventHandle:THandle;
    FWaitTime :Cardinal; {how long to wait for signal}
    //FCritSec:TCriticalSection; { critical section to prevent race condition at time of change of Signal states.}
    FOnWork:TNotifyEvent;

    FWorkCounter:Cardinal; { how many times have we been signalled }

    procedure Execute; override; { final; }

    //constructor Create(CreateSuspended: Boolean); { hide parent }
  public
    constructor Create;
    destructor Destroy; override;

    function WaitForSignal:Boolean; { returns TRUE if signal received, false if not received }

    function Active:Boolean; { is there work going on? }

    property WorkCounter:Cardinal read FWorkCounter; { how many times have we been signalled }

    procedure Sync(AMethod: TThreadMethod);

    procedure Start; { replaces method from TThread }
    procedure Stop; { provides an alternative to deprecated Suspend method }

    property Terminated; {make visible}

  published
      property WaitTime :Cardinal read FWaitTime write FWaitTime; {how long to wait for signal}

      property OnWork:TNotifyEvent read FOnWork write FOnWork;

end;

implementation

{ TSignalThread }

constructor TSignalThread.Create;
begin
  inherited Create({CreateSuspended}true);
 // must create event handle first!
  FEventHandle := CreateEvent(
          {security}      nil,
          {bManualReset}  true,
          {bInitialState} false,
          {name}          nil);

  FWaitTime := 10;
end;

destructor TSignalThread.Destroy;
begin
 if Self.Suspended or Self.Terminated then
    CloseHandle(FEventHandle);
  inherited;
end;



procedure TSignalThread.Execute;
begin
//  inherited; { not applicable here}
  while not Terminated do begin
      if WaitForSignal then begin
          Inc(FWorkCounter);
          if Assigned(FOnWork) then begin
              FOnWork(Self);
          end;
      end;
  end;
  OutputDebugString('TSignalThread shutting down');

end;

{ Active will return true when it is easily (instantly) apparent that
  we are not paused.  If we are not active, it is possible we are paused,
  or it is possible we are in some in-between state. }
function TSignalThread.Active: Boolean;
begin
 result := WaitForSingleObject(FEventHandle,0)= WAIT_OBJECT_0;
end;

procedure TSignalThread.Start;
begin
  SetEvent(FEventHandle); { when we are in a signalled state, we can do work}
  if Self.Suspended then
      inherited Start;

end;

procedure TSignalThread.Stop;
begin
    ResetEvent(FEventHandle);
end;

procedure TSignalThread.Sync(AMethod: TThreadMethod);
begin
 Synchronize(AMethod);
end;

function TSignalThread.WaitForSignal: Boolean;
var
 ret:Cardinal;
begin
  result := false;
  ret := WaitForSingleObject(FEventHandle,FWaitTime);
  if (ret=WAIT_OBJECT_0) then
      result := not Self.Terminated;
end;

end.

Answer 1

编辑：最新版本可以在 GitHub 上找到：https://github.com/darianmiller/d5xlib

我提出了这个解决方案作为 TThread 增强的基础，它具有不依赖于挂起/恢复的工作启动/停止机制。我喜欢有一个线程管理器来监控活动，它为此提供了一些管道。

unit soThread;

interface

uses
  Classes,
  SysUtils,
  SyncObjs,
  soProcessLock;


type

  TsoThread = class;
  TsoNotifyThreadEvent = procedure(const pThread:TsoThread) of object;
  TsoExceptionEvent = procedure(pSender:TObject; pException:Exception) of object;


  TsoThreadState = (tsActive,
                    tsSuspended_NotYetStarted,
                    tsSuspended_ManuallyStopped,
                    tsSuspended_RunOnceCompleted,
                    tsTerminationPending_DestroyInProgress,
                    tsSuspendPending_StopRequestReceived,
                    tsSuspendPending_RunOnceComplete,
                    tsTerminated);

  TsoStartOptions = (soRepeatRun,
                     soRunThenSuspend,
                     soRunThenFree);



  TsoThread = class(TThread)
  private
    fThreadState:TsoThreadState;
    fOnException:TsoExceptionEvent;
    fOnRunCompletion:TsoNotifyThreadEvent;
    fStateChangeLock:TsoProcessResourceLock;
    fAbortableSleepEvent:TEvent;
    fResumeSignal:TEvent;
    fTerminateSignal:TEvent;
    fExecDoneSignal:TEvent;
    fStartOption:TsoStartOptions;
    fProgressTextToReport:String;
    fRequireCoinitialize:Boolean;
    function GetThreadState():TsoThreadState;
    procedure SuspendThread(const pReason:TsoThreadState);
    procedure Sync_CallOnRunCompletion();
    procedure DoOnRunCompletion();
    property ThreadState:TsoThreadState read GetThreadState;
    procedure CallSynchronize(Method: TThreadMethod);
  protected
    procedure Execute(); override;

    procedure BeforeRun(); virtual;      // Override as needed
    procedure Run(); virtual; ABSTRACT;  // Must override
    procedure AfterRun(); virtual;       // Override as needed

    procedure Suspending(); virtual;
    procedure Resumed(); virtual;
    function ExternalRequestToStop():Boolean; virtual;
    function ShouldTerminate():Boolean;

    procedure Sleep(const pSleepTimeMS:Integer);  

    property StartOption:TsoStartOptions read fStartOption write fStartOption;
    property RequireCoinitialize:Boolean read fRequireCoinitialize write fRequireCoinitialize;
  public
    constructor Create(); virtual;
    destructor Destroy(); override;

    function Start(const pStartOption:TsoStartOptions=soRepeatRun):Boolean;
    procedure Stop();  //not intended for use if StartOption is soRunThenFree

    function CanBeStarted():Boolean;
    function IsActive():Boolean;

    property OnException:TsoExceptionEvent read fOnException write fOnException;
    property OnRunCompletion:TsoNotifyThreadEvent read fOnRunCompletion write fOnRunCompletion;
  end;


implementation

uses
  ActiveX,
  Windows;


constructor TsoThread.Create();
begin
  inherited Create(True); //We always create suspended, user must call .Start()
  fThreadState := tsSuspended_NotYetStarted;
  fStateChangeLock := TsoProcessResourceLock.Create();
  fAbortableSleepEvent := TEvent.Create(nil, True, False, '');
  fResumeSignal := TEvent.Create(nil, True, False, '');
  fTerminateSignal := TEvent.Create(nil, True, False, '');
  fExecDoneSignal := TEvent.Create(nil, True, False, '');
end;


destructor TsoThread.Destroy();
begin
  if ThreadState <> tsSuspended_NotYetStarted then
  begin
    fTerminateSignal.SetEvent();
    SuspendThread(tsTerminationPending_DestroyInProgress);
    fExecDoneSignal.WaitFor(INFINITE); //we need to wait until we are done before inherited gets called and locks up as FFinished is not yet set
  end;
  inherited;
  fAbortableSleepEvent.Free();
  fStateChangeLock.Free();
  fResumeSignal.Free();
  fTerminateSignal.Free();
  fExecDoneSignal.Free();
end;


procedure TsoThread.Execute();

            procedure WaitForResume();
            var
              vWaitForEventHandles:array[0..1] of THandle;
              vWaitForResponse:DWORD;
            begin
              vWaitForEventHandles[0] := fResumeSignal.Handle;
              vWaitForEventHandles[1] := fTerminateSignal.Handle;
              vWaitForResponse := WaitForMultipleObjects(2, @vWaitForEventHandles[0], False, INFINITE);
              case vWaitForResponse of
              WAIT_OBJECT_0 + 1: Terminate;
              WAIT_FAILED: RaiseLastOSError;
              //else resume
              end;
            end;
var
  vCoInitCalled:Boolean;
begin
  try
    try
      while not ShouldTerminate() do
      begin
        if not IsActive() then
        begin
          if ShouldTerminate() then Break;
          Suspending;
          WaitForResume();   //suspend()

          //Note: Only two reasons to wake up a suspended thread:
          //1: We are going to terminate it  2: we want it to restart doing work
          if ShouldTerminate() then Break;
          Resumed();
        end;

        if fRequireCoinitialize then
        begin
          CoInitialize(nil);
          vCoInitCalled := True;
        end;
        BeforeRun();
        try
          while IsActive() do
          begin
            Run(); //descendant's code
            DoOnRunCompletion();

            case fStartOption of
            soRepeatRun:
              begin
                //loop
              end;
            soRunThenSuspend:
              begin
                SuspendThread(tsSuspendPending_RunOnceComplete);
                Break;
              end;
            soRunThenFree:
              begin
                FreeOnTerminate := True;
                Terminate();
                Break;
              end;
            else
              begin
                raise Exception.Create('Invalid StartOption detected in Execute()');
              end;
            end;
          end;
        finally
          AfterRun();
          if vCoInitCalled then
          begin
            CoUnInitialize();
          end;
        end;
      end; //while not ShouldTerminate()
    except
      on E:Exception do
      begin
        if Assigned(OnException) then
        begin
          OnException(self, E);
        end;
        Terminate();
      end;
    end;
  finally
    //since we have Resumed() this thread, we will wait until this event is
    //triggered before free'ing.
    fExecDoneSignal.SetEvent();
  end;
end;


procedure TsoThread.Suspending();
begin
  fStateChangeLock.Lock();
  try
    if fThreadState = tsSuspendPending_StopRequestReceived then
    begin
      fThreadState := tsSuspended_ManuallyStopped;
    end
    else if fThreadState = tsSuspendPending_RunOnceComplete then
    begin
      fThreadState := tsSuspended_RunOnceCompleted;
    end;
  finally
    fStateChangeLock.Unlock();
  end;
end;


procedure TsoThread.Resumed();
begin
  fAbortableSleepEvent.ResetEvent();
  fResumeSignal.ResetEvent();
end;


function TsoThread.ExternalRequestToStop:Boolean;
begin
  //Intended to be overriden - for descendant's use as needed
  Result := False;
end;


procedure TsoThread.BeforeRun();
begin
  //Intended to be overriden - for descendant's use as needed
end;


procedure TsoThread.AfterRun();
begin
  //Intended to be overriden - for descendant's use as needed
end;


function TsoThread.Start(const pStartOption:TsoStartOptions=soRepeatRun):Boolean;
var
  vNeedToWakeFromSuspendedCreationState:Boolean;
begin
  vNeedToWakeFromSuspendedCreationState := False;

  fStateChangeLock.Lock();
  try
    StartOption := pStartOption;

    Result := CanBeStarted();
    if Result then
    begin
      if (fThreadState = tsSuspended_NotYetStarted) then
      begin
        //Resumed() will normally be called in the Exec loop but since we
        //haven't started yet, we need to do it here the first time only.
        Resumed();
        vNeedToWakeFromSuspendedCreationState := True;
      end;

      fThreadState := tsActive;

      //Resume();
      if vNeedToWakeFromSuspendedCreationState then
      begin
        //We haven't started Exec loop at all yet
        //Since we start all threads in suspended state, we need one initial Resume()
        Resume();
      end
      else
      begin
        //we're waiting on Exec, wake up and continue processing
        fResumeSignal.SetEvent();
      end;
    end;
  finally
    fStateChangeLock.Unlock();
  end;
end;


procedure TsoThread.Stop();
begin
  SuspendThread(tsSuspendPending_StopRequestReceived);
end;


procedure TsoThread.SuspendThread(const pReason:TsoThreadState);
begin
  fStateChangeLock.Lock();
  try
    fThreadState := pReason; //will auto-suspend thread in Exec
    fAbortableSleepEvent.SetEvent();
  finally
    fStateChangeLock.Unlock();
  end;
end;


procedure TsoThread.Sync_CallOnRunCompletion();
begin
  if Assigned(fOnRunCompletion) then fOnRunCompletion(Self);
end;


procedure TsoThread.DoOnRunCompletion();
begin
  if Assigned(fOnRunCompletion) then CallSynchronize(Sync_CallOnRunCompletion);
end;


function TsoThread.GetThreadState():TsoThreadState;
begin
  fStateChangeLock.Lock();
  try
    if Terminated then
    begin
      fThreadState := tsTerminated;
    end
    else if ExternalRequestToStop() then
    begin
      fThreadState := tsSuspendPending_StopRequestReceived;
    end;
    Result := fThreadState;
  finally
    fStateChangeLock.Unlock();
  end;
end;


function TsoThread.CanBeStarted():Boolean;
begin
  Result := (ThreadState in [tsSuspended_NotYetStarted,
                             tsSuspended_ManuallyStopped,
                             tsSuspended_RunOnceCompleted]);
end;

function TsoThread.IsActive():Boolean;
begin
  Result := (ThreadState = tsActive);
end;


procedure TsoThread.Sleep(const pSleepTimeMS:Integer);
begin
  fAbortableSleepEvent.WaitFor(pSleepTimeMS);
end;


procedure TsoThread.CallSynchronize(Method: TThreadMethod);
begin
  if IsActive() then
  begin
    Synchronize(Method);
  end;
end;

Function TsoThread.ShouldTerminate():Boolean;
begin
  Result := Terminated or
            (ThreadState in [tsTerminationPending_DestroyInProgress, tsTerminated]);
end;

end.

Answer 2

要详细说明原始答案（以及 Smasher 相当简短的解释），请创建一个 TEvent 对象。这是一个同步对象，用于让线程在正确的时间等待继续。

您可以将事件对象视为红色或绿色的交通信号灯。创建它时，它不会发出信号。 （红色）确保您的线程和您的线程正在等待的代码都引用了该事件。然后不要说Self.Suspend;，而是说EventObject.WaitFor(TIMEOUT_VALUE_HERE);。

当它等待的代码运行完毕时，你写的是EventObject.SetEvent;，而不是ThreadObject.Resume;。这会打开信号（绿灯）并让您的线程继续。

编辑：刚刚注意到上面有一个遗漏。 TEvent.WaitFor 是一个函数，而不是一个过程。请务必检查它的返回类型并做出适当的反应。

Answer 3

您可以使用事件 (CreateEvent) 并让线程等待 (WaitForObject) 直到事件发出信号 (SetEvent)。我知道这是一个简短的答案，但您应该能够在 MSDN 或任何您想要的地方查看这三个命令。他们应该做到这一点。

Answer 4

您的代码使用 Windows 事件句柄，最好使用来自 SyncObjs 单元的 TEvent，这样所有血淋淋的细节都会得到处理。

另外，我不明白等待时间的必要性 - 您的线程在事件上被阻塞或者不是，等待操作不需要超时。如果您这样做是为了能够关闭线程 - 最好使用第二个事件和 WaitForMultipleObjects() 来代替。示例见this answer (a basic implementation of a background thread to copy files)，您只需删除处理文件复制的代码并添加您自己的有效负载。您可以根据SetEvent() 和ResetEvent() 轻松实现Start() 和Stop() 方法，释放线程将正确关闭它。