unit LogCleanup;

interface

uses
  SiAuto, SmartInspect, SysUtils, Classes, SyncObjs;

const
  CFileName = 'log.sil';
  CMaxFiles = 10;
  CCleanupInterval = 1000 * 60 * 60;

type
  TLogCleanupThread = class(TThread)
  private
    FMaxFiles: Integer;
    FEvent: TEvent;
    FFileName: String;
    FCleanupInterval: Integer;
    procedure Cleanup;
  protected
    procedure Execute; override;
  public
    constructor Create(const AFileName: String = CFileName;
      const AMaxFiles: Integer = CMaxFiles;
      const ACleanupInterval: Integer = CCleanupInterval);
    destructor Destroy; override;
    procedure Cancel;
    property MaxFiles: Integer read FMaxFiles;
    property CleanupInterval: Integer read FCleanupInterval;
  end;

implementation

var
  GSession: TSiSession;

{ TLogCleanupThread }

procedure TLogCleanupThread.Cancel;
begin
  GSession.EnterMethod(Self, 'Cancel');
  GSession.LogWarning('Cancelling!');
  Terminate;
  FEvent.SetEvent;
  GSession.LeaveMethod(Self, 'Cancel');
end;

procedure TLogCleanupThread.Cleanup;
var
  LSearchRec: TSearchRec;
  LErrorCode: Integer;
  LMask, LPath: String;
  LLogFile: String;
  LFiles: TStringList;
  I: Integer;
begin
  GSession.EnterMethod(Self, 'Cleanup');

  LMask := ChangeFileExt(FFileName, '') + '*' + ExtractFileExt(FFileName);
  LErrorCode := FindFirst(LMask, 0, LSearchRec);

  if LErrorCode = 0 then
  begin
    try
      LFiles := TStringList.Create;
      try
        LFiles.Sorted := True;
        LPath := IncludeTrailingPathDelimiter(ExtractFilePath(FFileName));

        repeat
          LLogFile := LPath + LSearchRec.Name;
          LFiles.Add(LLogFile);
        until FindNext(LSearchRec) <> 0;

        GSession.LogStringList('LFiles', LFiles);

        if LFiles.Count > FMaxFiles then
        begin
          for I := 0 to Pred(LFiles.Count - FMaxFiles) do
          begin
            GSession.LogMessage(LFiles[I]);
            if not DeleteFile(LFiles[I]) then
            begin
              GSession.LogLastError('DeleteFile');
            end;
          end;
        end;
      finally
        LFiles.Free;
      end;
    finally
      FindClose(LSearchRec);
    end;
  end else
  begin
    GSession.LogString('LMask', LMask);
    GSession.LogWin32Error('FindFirst', LErrorCode);
  end;

  GSession.LeaveMethod(Self, 'Cleanup');
end;

constructor TLogCleanupThread.Create(const AFileName: String;
  const AMaxFiles: Integer; const ACleanupInterval: Integer);
begin
  inherited Create(True);
  FFileName := AFileName;
  FMaxFiles := AMaxFiles;
  FCleanupInterval := ACleanupInterval;
  FEvent := TEvent.Create(nil, False, False, '');
end;

destructor TLogCleanupThread.Destroy;
begin
  FreeAndNil(FEvent);
  inherited;
end;

procedure TLogCleanupThread.Execute;
begin
  GSession.EnterThread('Log Cleanup');
  while not Terminated do
  begin
    Cleanup;
    GSession.LogMessage('Waiting..');
    FEvent.WaitFor(FCleanupInterval);
  end;
  GSession.LeaveThread('Log Cleanup');
end;

initialization
  GSession := Si.AddSession('Log Cleanup');
end.

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FLogCleanup: TLogCleanupThread;
  end;

...

procedure TForm1.FormCreate(Sender: TObject);
begin
  FLogCleanup := TLogCleanupThread.Create('c:\Test\log.sil');
  FLogCleanup.Resume;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FLogCleanup.Cancel;
  FLogCleanup.WaitFor;
  FreeAndNil(FLogCleanup);
end;