StackOverflow2013

Note that there are some explanatory texts on larger screens.

plurals

PO
text
Body
copied!<p><strong>EDIT: Latest version can be found on GitHub: <a href="https://github.com/darianmiller/d5xlib" rel="nofollow noreferrer">https://github.com/darianmiller/d5xlib</a></strong></p> <p>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.</p> <pre><code>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. </code></pre>

Querying!

Guidance

An individual column

Larger individual text columns get their own page to allow for proper reading.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload