multitarea hilos delphi tthread

hilos - delphi multitarea



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

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.


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.


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.


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.


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.