之前曾有人问过，但without a full answer。这与所谓的“致命线程模型！”有关。
我需要用安全的东西替换对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.
最佳答案
编辑：最新版本可以在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.
关于delphi - 我应该用什么delphi Code替换对不赞成使用的TThread方法Suspend的调用？，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/2097316/