With what delphi Code should I replace my calls to deprecated TThread method Suspend?

Question

It has been asked before, but without a full answer. This is to do with the so called famous \"‘Fatal threading model!’\".

I need to replace this call to TThread.Su

Answer 1

EDIT: Latest version can be found on GitHub: https://github.com/darianmiller/d5xlib

I've come up with this solution as a basis for TThread enhancement with a working Start/Stop mechanism that doesn't rely on Suspend/Resume. I like to have a thread manager that monitors activity and this provides some of the plumbing for that.

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.