編集：最新バージョンは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.