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

发布于 2024-08-18 14:25:10 字数 3873 浏览 2 评论 0原文

之前已被问过,但是 没有完整的答案。这与所谓的著名的“‘致命线程模型!’”有关。

我需要用安全的东西替换对 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。

下面是带有 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.

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.Suspend with something safe, that returns when terminated or resumed:

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;

The original answer vaguely suggests "TMutex, TEvent and critical sections".

I guess I'm looking for a TThreadThatDoesntSuck.

Here's the sample TThread derivative with a Win32Event, for comments:

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.

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(4

做个ˇ局外人 2024-08-25 14:25:10

编辑:最新版本可以在 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.

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.
云雾 2024-08-25 14:25:10

为了详细说明原始答案(以及 Smasher 相当简短的解释),请创建一个 TEvent 对象。这是一个同步对象,用于线程等待正确的时间继续。

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

当它等待的代码运行完毕时,您可以编写 EventObject.SetEvent;,而不是 ThreadObject.Resume;。这将打开信号(绿灯)并让您的线程继续。

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

To elaborate on the original answer, (and on Smasher's rather short explanation), create a TEvent object. This is a synchronization object that's used for threads to wait on the right time to continue.

You can think of the event object as a traffic light that's either red or green. When you create it, it's not signaled. (Red) Make sure that both your thread and the code that your thread is waiting on have a reference to the event. Then instead of saying Self.Suspend;, say EventObject.WaitFor(TIMEOUT_VALUE_HERE);.

When the code that it's waiting on is finished running, instead of saying ThreadObject.Resume;, you write EventObject.SetEvent;. This turns the signal on (green light) and lets your thread continue.

EDIT: Just noticed an omission above. TEvent.WaitFor is a function, not a procedure. Be sure to check it's return type and react appropriately.

回忆那么伤 2024-08-25 14:25:10

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

You could use an event (CreateEvent) and let the thread wait (WaitForObject) until the event is signaled (SetEvent). I know that this is a short answer, but you should be able to look these three commands up on MSDN or wherever you want. They should do the trick.

鹿港小镇 2024-08-25 14:25:10

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

另外,我不明白等待时间的必要性 - 您的线程要么被事件阻塞,要么没有被阻塞,等待操作不需要超时。如果您这样做是为了能够关闭线程 - 最好使用第二个事件和 WaitForMultipleObjects() 代替。有关示例,请参阅 这个答案(复制文件的后台线程的基本实现),您只需要删除处理文件复制的代码并添加您自己的有效负载即可。您可以根据 SetEvent()ResetEvent() 轻松实现 Start()Stop() 方法>,释放线程将正确关闭它。

Your code uses a Windows event handle, it should better be using a TEvent from the SyncObjs unit, that way all the gory details will already be taken care of.

Also I don't understand the need for a waiting time - either your thread is blocked on the event or it isn't, there is no need for the wait operation to time out. If you do this to be able to shut the thread down - it's much better to use a second event and WaitForMultipleObjects() instead. For an example see this answer (a basic implementation of a background thread to copy files), you only need to remove the code dealing with file copying and add your own payload. You can easily implement your Start() and Stop() methods in terms of SetEvent() and ResetEvent(), and freeing the thread will properly shut it down.

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文