How to make a thread finish its work before being free'd?

Question

I\'m writing a thread which writes event logs. When the application is closed (gracefully), I need to make sure this thread finishes its job saving the logs before it\'s fre

Answer 1

Here is a "lazy" EventLogger thread which will save all events in the queue.

unit EventLogger;

interface

uses
  Classes, SyncObjs, Contnrs;

type
  TEventItem = class
    TimeStamp : TDateTime;
    Info : string;
  end;

  TEventLogger = class( TThread )
  private
    FStream : TStream;
    FEvent :  TEvent;
    FQueue :  TThreadList;
  protected
    procedure TerminatedSet; override;
    procedure Execute; override;
    procedure WriteEvents;
    function GetFirstItem( out AItem : TEventItem ) : Boolean;
  public
    constructor Create; overload;
    constructor Create( CreateSuspended : Boolean ); overload;
    destructor Destroy; override;

    procedure LogEvent( const AInfo : string );
  end;

implementation

uses
  Windows, SysUtils;

{ TEventLogger }

constructor TEventLogger.Create( CreateSuspended : Boolean );
begin
  FEvent := TEvent.Create;
  FQueue := TThreadList.Create;

  inherited;
end;

constructor TEventLogger.Create;
begin
  Create( False );
end;

destructor TEventLogger.Destroy;
begin
  // first the inherited part
  inherited;
  // now freeing the internal instances
  FStream.Free;
  FQueue.Free;
  FEvent.Free;
end;

procedure TEventLogger.Execute;
var
  LFinished : Boolean;
begin
  inherited;
  LFinished := False;
  while not LFinished do
    begin

      // waiting for event with 20 seconds timeout
      // maybe terminated or full queue
      WaitForSingleObject( FEvent.Handle, 20000 );

      // thread will finished if terminated
      LFinished := Terminated;

      // write all events from queue
      WriteEvents;

      // if the thread gets terminated while writing
      // it will be still not finished ... and therefor one more loop

    end;
end;

function TEventLogger.GetFirstItem( out AItem : TEventItem ) : Boolean;
var
  LList : TList;
begin
  LList := FQueue.LockList;
  try
    if LList.Count > 0
    then
      begin
        AItem := TEventItem( LList[0] );
        LList.Delete( 0 );
        Result := True;
      end
    else
      Result := False;
  finally
    FQueue.UnlockList;
  end;
end;

procedure TEventLogger.LogEvent( const AInfo : string );
var
  LList : TList;
  LItem : TEventItem;
begin
  if Terminated
  then
    Exit;

  LItem           := TEventItem.Create;
  LItem.TimeStamp := now;
  LItem.Info      := AInfo;

  LList := FQueue.LockList;
  try

    LList.Add( LItem );

    // if the queue is "full" we will set the event

    if LList.Count > 50
    then
      FEvent.SetEvent;

  finally
    FQueue.UnlockList;
  end;

end;

procedure TEventLogger.TerminatedSet;
begin
  // this is called if the thread is terminated
  inherited;
  FEvent.SetEvent;
end;

procedure TEventLogger.WriteEvents;
var
  LItem :   TEventItem;
  LStream : TStream;
begin
  // retrieve the first event in list
  while GetFirstItem( LItem ) do
    try

      // writing the event to a file

      if not Assigned( FStream )
      then
        FStream := TFileStream.Create( ChangeFileExt( ParamStr( 0 ), '.log' ), fmCreate or fmShareDenyWrite );

      // just a simple log row
      LStream := 
        TStringStream.Create( 
          Format( 
            '[%s] %s : %s', 
             // when it is written to file
            [FormatDateTime( 'dd.mm.yyyy hh:nn:ss.zzz', now ),
             // when did it happend
             FormatDateTime( 'dd.mm.yyyy hh:nn:ss.zzz', LItem.TimeStamp ),
             // whats about 
             LItem.Info] ) + sLineBreak, 
          TEncoding.UTF8 );
      try
        LStream.Seek( 0, soFromBeginning );
        FStream.CopyFrom( LStream, LStream.Size );
      finally
        LStream.Free;
      end;

    finally
      LItem.Free;
    end;
end;

end.