unit X2Log.Observer.CustomThreaded; interface uses System.Classes, System.Generics.Collections, System.SyncObjs, X2Log.Intf, X2Log.Observer.Custom; type TX2LogObserverWorkerThread = class; TX2LogCustomThreadedObserver = class(TX2LogCustomObserver) private FWorkerThread: TX2LogObserverWorkerThread; protected function CreateWorkerThread: TX2LogObserverWorkerThread; virtual; abstract; procedure DoLog(ALevel: TX2LogLevel; ADateTime: TDateTime; const AMessage, ACategory: string; ADetails: IX2LogDetails); override; property WorkerThread: TX2LogObserverWorkerThread read FWorkerThread; public constructor Create(ALogLevels: TX2LogLevels = X2LogLevelsDefault); destructor Destroy; override; end; TX2LogQueueEntry = class(TPersistent) private FDetails: IX2LogDetails; FLevel: TX2LogLevel; FDateTime: TDateTime; FCategory: string; FMessage: string; public constructor Create(ALevel: TX2LogLevel; ADateTime: TDateTime; const AMessage, ACategory: string; ADetails: IX2LogDetails); overload; constructor Create(AEntry: TX2LogQueueEntry); overload; procedure Assign(Source: TPersistent); override; property DateTime: TDateTime read FDateTime; property Details: IX2LogDetails read FDetails; property Level: TX2LogLevel read FLevel; property Category: string read FCategory; property Message: string read FMessage; end; TX2LogObserverWorkerThread = class(TThread) private FLogQueue: TObjectQueue; FLogQueueSignal: TEvent; FThreadStartSignal: TEvent; protected procedure Execute; override; procedure TerminatedSet; override; procedure Setup; virtual; procedure Cleanup; virtual; procedure WaitForEntry; virtual; procedure ProcessEntry(AEntry: TX2LogQueueEntry); virtual; abstract; property LogQueue: TObjectQueue read FLogQueue; property LogQueueSignal: TEvent read FLogQueueSignal; public constructor Create; destructor Destroy; override; procedure Log(ALevel: TX2LogLevel; ADateTime: TDateTime; const AMessage, ACategory: string; ADetails: IX2LogDetails); end; implementation uses System.SysUtils; { TX2LogCustomThreadedObserver } constructor TX2LogCustomThreadedObserver.Create(ALogLevels: TX2LogLevels); begin inherited Create(ALogLevels); FWorkerThread := CreateWorkerThread; end; destructor TX2LogCustomThreadedObserver.Destroy; begin FreeAndNil(FWorkerThread); inherited Destroy; end; procedure TX2LogCustomThreadedObserver.DoLog(ALevel: TX2LogLevel; ADateTime: TDateTime; const AMessage, ACategory: string; ADetails: IX2LogDetails); begin WorkerThread.Log(ALevel, ADateTime, AMessage, ACategory, ADetails); end; { TX2LogQueueEntry } constructor TX2LogQueueEntry.Create(ALevel: TX2LogLevel; ADateTime: TDateTime; const AMessage, ACategory: string; ADetails: IX2LogDetails); begin inherited Create; FLevel := ALevel; FDateTime := ADateTime; FCategory := ACategory; FMessage := AMessage; FDetails := ADetails; end; constructor TX2LogQueueEntry.Create(AEntry: TX2LogQueueEntry); begin inherited Create; Assign(AEntry); end; procedure TX2LogQueueEntry.Assign(Source: TPersistent); var entrySource: TX2LogQueueEntry; begin if Source is TX2LogQueueEntry then begin entrySource := TX2LogQueueEntry(Source); FLevel := entrySource.Level; FDateTime := entrySource.DateTime; FCategory := entrySource.Category; FMessage := entrySource.Message; FDetails := entrySource.Details; end else inherited Assign(Source); end; { TX2LogObserverWorkerThread } constructor TX2LogObserverWorkerThread.Create; begin FThreadStartSignal := TEvent.Create(nil, True, False, ''); FLogQueueSignal := TEvent.Create(nil, True, False, ''); FLogQueue := TObjectQueue.Create(True); inherited Create(False); end; destructor TX2LogObserverWorkerThread.Destroy; begin { For very short-lived observers (for example, the "Save as" functionality of the observer form) the WorkerThread can be destroyed before the thread has a chance to properly start and clear out it's queue. } FThreadStartSignal.WaitFor(INFINITE); inherited Destroy; FreeAndNil(FLogQueue); FreeAndNil(FLogQueueSignal); FreeAndNil(FThreadStartSignal); end; procedure TX2LogObserverWorkerThread.Log(ALevel: TX2LogLevel; ADateTime: TDateTime; const AMessage, ACategory: string; ADetails: IX2LogDetails); var details: IX2LogDetails; begin details := nil; if Assigned(ADetails) then details := ADetails.Clone; TMonitor.Enter(LogQueue); try LogQueue.Enqueue(TX2LogQueueEntry.Create(ALevel, ADateTime, AMessage, ACategory, details)); LogQueueSignal.SetEvent; finally TMonitor.Exit(LogQueue); end; end; procedure TX2LogObserverWorkerThread.Execute; var entry: TX2LogQueueEntry; begin FThreadStartSignal.SetEvent; NameThreadForDebugging('TX2LogObserverWorkerThread'); Setup; try while True do begin { When Terminated, flush the queue } if not Terminated then WaitForEntry; entry := nil; TMonitor.Enter(LogQueue); try if LogQueue.Count > 0 then entry := LogQueue.Extract else LogQueueSignal.ResetEvent; finally TMonitor.Exit(LogQueue); end; if Assigned(entry) then try ProcessEntry(entry); finally FreeAndNil(entry); end else if Terminated then break; end; finally Cleanup; end; end; procedure TX2LogObserverWorkerThread.Setup; begin end; procedure TX2LogObserverWorkerThread.Cleanup; begin end; procedure TX2LogObserverWorkerThread.WaitForEntry; begin case LogQueueSignal.WaitFor(INFINITE) of wrAbandoned, wrError: Terminate; end; end; procedure TX2LogObserverWorkerThread.TerminatedSet; begin LogQueueSignal.SetEvent; inherited TerminatedSet; end; end.