Подтвердить что ты не робот

С каким кодом delphi я должен заменить свои вызовы на устаревший метод TThread Suspend?

Он был задан раньше, но без полного ответа. Это связано с так называемой известной "фатальной моделью резьбы!".

Мне нужно заменить этот вызов на 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.

Здесь образец производной TThread с Win32Event, для комментариев:

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.
4b9b3361

ОТВЕТЫ

Ответ 1

EDIT: последнюю версию можно найти на GitHub: https://github.com/darianmiller/d5xlib

Я придумал это решение в качестве основы для улучшения TThread с помощью рабочего механизма Start/Stop, который не полагается на Suspend/Resume. Мне нравится иметь диспетчера потоков, который контролирует активность, и это обеспечивает некоторые из сантехники для этого.

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 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 use as needed
  Result := False;
end;


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


procedure TsoThread.AfterRun();
begin
  //Intended to be overriden - for descendant 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.

Ответ 2

Чтобы подробно описать исходный ответ (и на кратком объяснении Smasher), создайте объект TEvent. Это объект синхронизации, который используется для того, чтобы потоки могли ждать в нужное время, чтобы продолжить.

Вы можете представить объект события как светофор, красный или зеленый. Когда вы его создаете, он не сигнализируется. (Красный) Убедитесь, что и ваш поток, и код, который ожидает ваш поток, имеют ссылку на событие. Затем вместо слова Self.Suspend; скажем EventObject.WaitFor(TIMEOUT_VALUE_HERE);.

Когда код, который он ожидает, закончен, вместо того, чтобы говорить ThreadObject.Resume;, вы пишете EventObject.SetEvent;. Это включает сигнал (зеленый свет) и позволяет продолжить поток.

РЕДАКТИРОВАТЬ: Просто заметил упущение выше. TEvent.WaitFor - это функция, а не процедура. Обязательно проверьте его тип возврата и отреагируйте соответствующим образом.

Ответ 3

Вы можете использовать событие (CreateEvent) и позволить потоку ждать (WaitForObject) до тех пор, пока не будет сообщено о событии (SetEvent). Я знаю, что это короткий ответ, но вы должны смотреть эти три команды на MSDN или где хотите. Они должны сделать трюк.

Ответ 4

В вашем коде используется дескриптор события Windows, лучше использовать TEvent из блока SyncObjs, так что все детали gory уже будут рассмотрены.

Также я не понимаю необходимости в ожидании - либо ваш поток заблокирован в событии, либо нет, нет необходимости ждать операции ожидания. Если вы сделаете это, чтобы закрыть поток, лучше использовать второе событие и WaitForMultipleObjects(). В качестве примера см. этот ответ (базовая реализация фонового потока для копирования файлов), вам нужно только удалить код, связанный с копированием файлов, и добавить свою собственную полезную нагрузку. Вы можете легко реализовать свои методы Start() и Stop() с точки зрения SetEvent() и ResetEvent(), и освобождение потока будет правильно закрыто.