hilos - delphi multitarea

¿Con qué código Delphi debo reemplazar mis llamadas al método TThread en desuso Suspender?

Question

Se ha preguntado antes, pero sin una respuesta completa . Esto tiene que ver con el llamado "famoso modelo de enhebrado fatal".

Necesito reemplazar esta llamada a TThread. Suspender con algo seguro, que devuelve cuando se termina o se reanuda:

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;

La respuesta original sugiere vagamente "TMutex, TEvent y secciones críticas".

Creo que estoy buscando un TThreadThatDoesntSuck.

Aquí está la muestra del derivado TThread con un evento Win32Event, para comentarios:

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.

Answer 1

Puede usar un evento ( CreateEvent ) y dejar que el hilo espere ( WaitForObject ) hasta que se WaitForObject el evento ( SetEvent ). Sé que esta es una respuesta corta, pero debería poder ver estos tres comandos en MSDN o donde quiera. Deberían hacer el truco.

Answer 2

Para profundizar en la respuesta original, (y en la breve explicación de Smasher), crea un objeto TEvent. Este es un objeto de sincronización que se utiliza para que los subprocesos esperen en el momento adecuado para continuar.

Puede pensar en el objeto del evento como un semáforo que sea rojo o verde. Cuando lo creas, no se señaliza. (Rojo) Asegúrese de que tanto el hilo como el código que está esperando el hilo tengan una referencia al evento. Entonces, en lugar de decir Self.Suspend; , decir EventObject.WaitFor(TIMEOUT_VALUE_HERE); .

Cuando el código que está esperando termina de ejecutarse, en lugar de decir ThreadObject.Resume; , escribe EventObject.SetEvent; . Esto enciende la señal (luz verde) y permite que su hilo continúe.

EDITAR: Acabo de notar una omisión de arriba. TEvent.WaitFor es una función, no un procedimiento. Asegúrese de verificar su tipo de devolución y reaccionar de manera adecuada.

Answer 3

EDITAR: la última versión se puede encontrar en GitHub: https://github.com/darianmiller/d5xlib

He llegado a esta solución como base para la mejora TThread con un mecanismo de inicio / detención que no depende de suspender / reanudar. Me gusta tener un administrador de subprocesos que supervisa la actividad y esto proporciona algunas de las fontanería para eso.

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.

Answer 4

Su código usa un identificador de evento de Windows, debería usar un TEvent de la unidad SyncObjs , de esa manera todos los detalles sangrientos ya estarán SyncObjs .

Además, no entiendo la necesidad de un tiempo de espera, ya sea que su tema esté bloqueado en el evento o no, no es necesario agotar el tiempo de espera. Si haces esto para poder cerrar el hilo, es mucho mejor usar un segundo evento y WaitForMultipleObjects() lugar. Para ver un ejemplo, vea esta respuesta (una implementación básica de un hilo de fondo para copiar archivos) , solo necesita eliminar el código relacionado con la copia de archivos y agregar su propia carga útil. Puede implementar fácilmente sus métodos Start() y Stop() en términos de SetEvent() y ResetEvent() , y liberar el hilo lo cerrará correctamente.