以前被问过,但是
without a full answer.这是所谓的着名的“致命线程模型!”。
我需要将这个调用替换为一个安全的东西,在终止或恢复时返回:
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.
解决方法
编辑:最新版本可以在GitHub:
https://github.com/darianmiller/d5xlib找到
我已经提出了这个解决方案作为TThread增强的基础,并使用了一个不依赖于Suspend / Resume的启动/停止机制。我喜欢有一个线程管理器监视活动,这提供了一些管道。
unit soThread; interface uses Classes,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,''); fTerminateSignal := TEvent.Create(nil,''); fExecDoneSignal := TEvent.Create(nil,''); 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],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_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.