Multithread debug logger for Free Pascal / Lazarus

Debug experience can be much improved in the Lazarus development interface. Please, if you use this free development environment and have the same felling, do not consider this affirmation simply as a "drawback". I would rather consider it as a challenge for improved documentation and contributing back to the community.

I have written this debug logger for this project, a multithread program, specifically for the Free Pascal/Lazarus development environment. It logs messages in several textfiles in real time at runtime, asynchronously from different threads. At the end, all the messages are copied to a single file. I am logging timestamped messages, so it is not a problem for me. There is no console/terminal integration.

Feel free to suggest improvements considering the debugging experience:

1. Ease of use
2. Prompt feedback
3. Limits of this method for the debugging task itself
4. Alternatives?

unit debug_logger;

{$mode objfpc}{$H+}

interface

uses LCLProc, regdata;

procedure DebugLn(msg : string);

procedure DebuglnThreadLog(const Msg: string);

var
  Logger : TRegData;

const
    // message types
    mt_Debug : string = '[debug]' + #32;
    mt_Exception : string = '[except]' + #32;
    mt_Information : string = '[information]' + #32;
    mt_Warning : string = '[warning]' + #32;

implementation

uses LCLIntf, FileUtil, SysUtils;

var
  FileInfo : TSearchRec;

procedure DebugLn(msg: string);
begin
  DebuglnThreadLog(msg);
end;

procedure DebuglnThreadLog(const Msg: string);
var
  PID: PtrInt;
begin
  PID:=PtrInt(GetThreadID);
  DbgOutThreadLog(IntToStr(GetTickCount) + ' : ' + IntToStr(PtrInt(PID)) + ' : ' + Msg + LineEnding);
end;

initialization
begin
  Logger := TRegData.Create(nil, GetCurrentDirUTF8 + PathDelim + '_Log_001.txt');
end

finalization
begin
  if FindFirst('Log*',faAnyFile, FileInfo) = 0 then
    begin
      repeat
        with FileInfo do
          begin
            if TextRec(Logger.DataFile).Mode <> 55218 then
              begin
                Logger.AssignFFile;
                Logger.AppendF;
              end;
            WriteLn(Logger.DataFile, Name);
            WriteLn(Logger.DataFile, ReadFileToString(Name));
            DeleteFile(Name);
          end;
          WriteLn(Logger.DataFile, #10#10);
      until FindNext(FileInfo) <> 0;
      Logger.CloseFFile;
    end;
  FindClose(FileInfo);
  Logger.Free;
end

end.

And the register/writer class:

unit regdata;

{$mode objfpc}{$H+}

interface

uses SysUtils, Classes, FileUtil
    //, Dialogs
    ;

type

  { TRegData }

  TRegData = class(TComponent)
  private
    FFileName: string;
    FFile: TextFile;
    FSessionNumber: integer;
    procedure UpdateFileName(NewFileName : string);
  public
    constructor Create(AOwner: TComponent; FileName: String); reintroduce;
    destructor Destroy; override;
    procedure SaveData(Data: string);
    procedure AppendF;
    procedure AssignFFile;
    procedure CloseFFile;
    property SessionNumber : integer read FSessionNumber write FSessionNumber;
    property DataFile : TextFile read FFile write FFile;
    property FileName : string read FFileName write UpdateFileName;
  end;

implementation

   {

   Do not use the DebugLn inside this unit
   it will create a circular reference.
   use writeln instead.
   yeah.. need to find a way to debug the debugger.

   }

{$ifdef DEBUG}
  uses debug_logger, Dialogs;
{$endif}

procedure TRegData.UpdateFileName(NewFileName : string);
begin
  if (NewFileName <> '') and (NewFileName <> FFilename) then
    if FileExistsUTF8(NewFileName) then
      FFileName := NewFileName;
end;

constructor TRegData.Create(AOwner: TComponent; FileName: String);
var
  i, ExtensionLength : Integer;

  sName, aSeparator, aExtension: string;

      {

       We expect a filename with that structure:
       Data_001.txt or Data_001.timestamp
       4 char => sName
       1 char = aSeparator
       3 char = StringOfChar
       4 char = '.TXT' Extention or 10 char = '.timestamps' extension

       note : we begin from i := 1;
      }

begin
  inherited Create(AOwner);
  if FileName <> '' then
    begin
      ForceDirectoriesUTF8(ExtractFilePath(FileName)); { *Converted from ForceDirectories*  }

      if Pos('timestamps', FileName) <> 0 then
        begin
          ExtensionLength := 10;
        end
      else ExtensionLength := 3;

      i := 0;
      sName:= Copy(FileName, 0, Length(FileName)- (ExtensionLength + 5));
      aExtension := Copy(FileName, Length(FileName) - ExtensionLength, ExtensionLength + 1);
      aSeparator := '_';

      // ensure to never override an exinting data file
      while FileExistsUTF8(FileName) do begin
        Inc(i);
        FileName:= sName + aSeparator + StringOfChar(#48, 3 - Length(IntToStr(i))) + IntToStr(i) + aExtension;
      end;

      FSessionNumber := i;
      FFileName := FileName;

      // as override is impossible, don't mind about an Assign/Rewrite conditional
      AssignFile(FFile, FileName);
      Rewrite(FFile);

      {$ifdef DEBUG}
        WriteLn(FFile, mt_Debug + 'Saving data to:' + FFileName )
      {$endif}
   end;
end;

destructor TRegData.Destroy;
// With the current implementation
// if undefined DEBUG, CloseFile should be called only once
begin
  if FFilename <> '' then
    if TextRec(FFile).Mode = 55218 then // file is opened read/write
      begin
        CloseFile(FFile);
      end;
  inherited Destroy;
end;

procedure TRegData.SaveData(Data: string);
//var bol : Boolean;
begin
  if FFileName <> '' then
    begin
      Write(FFile, Data);
    end
  else {$ifdef DEBUG}  WriteLn( FFile, mt_Warning + 'Filename is empty.' + '[' + Data + ']' + 'will not be saved.' + LineEnding)  {$endif} ;
end;

procedure TRegData.AppendF;
begin
  Append(FFile);
end;

procedure TRegData.AssignFFile;
begin
  AssignFile(FFile, FFileName);
end;

procedure TRegData.CloseFFile;
begin
  CloseFile(FFile);
end;


end.