TDLogger

unit classDLogger;

interface

{ Created by Wisnu Widiarta - 23rd April 2005 }

uses
  Classes, ExtCtrls, IniFiles, SysUtils;

type
  TLogLevel = (llAll = 4, llInfo = 3, llWarning = 2, llError = 1, llDebug = 0);

  TDLogger = class(TObject)
  private
    FTmrLogger: TTimer;
    FListLogger: TStringList;
    FlogLevel: TLogLevel;
    FIniFile: TIniFile;
    FActive: Boolean;
    function getFormatDateTime: String;
    function getDateTime: String;
    procedure saveToFile;
    procedure tmrSaveToFile(Sender: TObject);
    procedure SetActive(const Value: Boolean);
  protected
    constructor Create(configFileName: String);
  public
    destructor Destroy; override;
    procedure info(event: String);
    procedure error(event: String);
    procedure debug(event: String);
    procedure setLogLevel(logLevel: TLogLevel);
    procedure setWriteIntervalInMinute(minute: integer);
    procedure setWriteIntervalInSecond(second: integer);
    class function getInstance: TDLogger;
    property Active: Boolean read FActive write SetActive;
  end;

  TFileDumper = class(TThread)
  private
    FFileName: String;
    FListLogger: TStringList;
    procedure saveToFile;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: Boolean; fileName: String;
      list: TStringList);
  end;

implementation

uses Forms, SyncObjs;

{ TDLogger }
var
  instance: TDLogger;

constructor TDLogger.Create(configFileName: String);
begin
  FTmrLogger := TTimer.Create(Nil);
  FTmrLogger.Enabled := False;
  FTmrLogger.OnTimer := Self.tmrSaveToFile;
  Self.setWriteIntervalInMinute(1);
  setLogLevel(llAll);

  FListLogger := TStringList.Create;
  FIniFile := TIniFile.Create(configFileName);
  FTmrLogger.Enabled := True;

  FActive := True;
end;

procedure TDLogger.debug(event: String);
begin
  if FlogLevel in [llDebug, llAll] then
    FListLogger.Add('DEBUG | ' + getDateTime + ' | ' + event);
end;

destructor TDLogger.Destroy;
begin
  saveToFile;

  FListLogger.Free;
  FTmrLogger.Enabled := False;
  FTmrLogger.Free;
  FIniFile.Free;

  instance := Nil;

  inherited;
end;

procedure TDLogger.error(event: String);
begin
  if FlogLevel in [llError, llAll] then
    FListLogger.Add('ERROR | ' + getDateTime + ' | ' + event);
end;

function TDLogger.getDateTime: String;
begin
  Result := FormatDateTime(getFormatDateTime, Now);
end;

function TDLogger.getFormatDateTime: String;
begin
  Result := FIniFile.ReadString('DATETIME', 'FORMAT', 'DD/MM/YYYY HH:MM:SS');
end;

class function TDLogger.getInstance: TDLogger;
begin
  if instance = nil then
    instance := TDLogger.Create(ExtractFileDir(ParamStr(0)) + 'DLOGGER.INI');

  Result := instance;
end;

procedure TDLogger.info(event: String);
begin
  if FlogLevel in [llInfo, llAll] then
    FListLogger.Add('INFO | ' + getDateTime + ' | ' + event);
end;

procedure TDLogger.saveToFile;
var
  fileName, folder, fileSuffix: String;
  listLogger: TStringList;
begin
  folder := FIniFile.ReadString('OUTPUT', 'FOLDER',
    ExtractFileDir(ParamStr(0)));
  fileSuffix := FIniFile.ReadString('OUTPUT', 'FILE', 'LOGFILE');
  fileName := folder + '' + fileSuffix + FormatDateTime('-YYYY-MM-DD', Now)
    + '.TXT';

  listLogger := TStringList.Create;
  listLogger.Assign(FListLogger);
  FListLogger.Clear;

  TFileDumper.Create(False, fileName, listLogger);
  listLogger.Free;
end;

procedure TDLogger.SetActive(const Value: Boolean);
begin
  FActive := Value;
end;

procedure TDLogger.setLogLevel(logLevel: TLogLevel);
begin
  FlogLevel := logLevel;
end;

procedure TDLogger.setWriteIntervalInMinute(minute: integer);
begin
  FTmrLogger.Enabled := False;
  FTmrLogger.Interval := minute * 60 * 1000;
  FTmrLogger.Enabled := True;
end;

procedure TDLogger.setWriteIntervalInSecond(second: integer);
begin
  FTmrLogger.Enabled := False;
  FTmrLogger.Interval := second * 1000;
  FTmrLogger.Enabled := True;
end;

procedure TDLogger.tmrSaveToFile(Sender: TObject);
begin
  if Active then
    saveToFile;
end;

{ TFileDumper }

constructor TFileDumper.Create(CreateSuspended: Boolean; fileName: String;
  list: TStringList);
begin
  inherited Create(Suspended);
  FreeOnTerminate := True;

  FListLogger := TStringList.Create;
  FListLogger.Assign(list);
  FFileName := fileName;
end;

procedure TFileDumper.Execute;
begin
  saveToFile;
end;

procedure TFileDumper.saveToFile;
var
  fileName: String;
  logFile: TextFile;
  i: integer;
  cs: TCriticalSection;
begin
  fileName := FFileName;

  cs := TCriticalSection.Create;
  cs.Acquire;
  try
    try
      AssignFile(logFile, fileName);
      if FileExists(fileName) then
        Append(logFile)
      else
        Rewrite(logFile);

      i := 0;
      while (i < FListLogger.Count) do
      begin
        writeln(logFile, FListLogger[i]);
        Inc(i);
        if (i Mod 100 = 0) then
          Application.ProcessMessages;
      end;

      Flush(logFile);
    finally
      CloseFile(logFile);
      FListLogger.Free;
      cs.Release;
      cs.Free;
    end;
  except
    on E: Exception do
    begin
      // there is nothing to do
    end;
  end;
end;
end.