[zhirnov.ilya.lvovich]

По сути работать должно во всех системах win и *nix - то на чём проверял, но, судя по коду TDirectory и TPath работать будет и на mac и на мобилках

Использование:

Код:

  log.info('...');

что стоит доделать:
- можно сделать запись в лог в отдельном потоке. только тогда надо научить ждать пока предыдущий поток не закончил запись
- чтение параметров логирования из какого-нибудь ini.

Код:

unit CommonLog;
 
interface

uses System.Classes;

type
TCommonLogLevel = (cllInfo, cllDebug, cllWarning, cllError, cllFatalError);

TCommonLog = class
  private
    FUseLog: boolean;
    FLogLevel: integer;
    FAppName: string;
    FFolderName: string;
    FCurrentFileName: string;
    FCurrentDate: TDate;
    procedure DoLogLevel(const ALevel: TCommonLogLevel; const AMessage: string);
    function GetFileName: string;
    function GetLevelName(const ALevel: TCommonLogLevel): string;
    function CheckLogLevel(const ALevel: TCommonLogLevel): boolean;
  public
    constructor Create; overload;
    procedure Info(const AMessage: string);
    procedure Debug(const AMessage: string);
    procedure Warning(const AMessage: string);
    procedure Error(const AMessage: string);
    procedure FatalError(const AMessage: string);
end;

function Log: TCommonLog;

implementation

uses System.SysUtils, System.IOUtils{$IFDEF MSWINDOWS}, Winapi.Windows {$ENDIF};

resourcestring
  rsInfo       = 'Information';
  rsDebug      = 'Debug';
  rsWarning    = 'Warning';
  rsError      = 'Error';
  rsFatalError = 'Fatal error';
  rsUnknown    = 'Unknown';

const
  C_DefaultUseLog     = True;
  C_DefaultLogLevel   = integer(cllInfo);
  C_DefaultAppName    = 'App';
  C_DefaultFolderName = 'logs';

var
  FLog: TCommonLog = nil;

function Log: TCommonLog;
begin
  if not Assigned(FLog) then
    FLog := TCommonLog.Create;
  Result := FLog;
end;

{ TCommonLog }

function TCommonLog.CheckLogLevel(const ALevel: TCommonLogLevel): boolean;
begin
  Result := False;
  if not FUseLog then exit;
  if integer(ALevel) < FLogLevel then exit;
  Result := True;
end;

procedure TCommonLog.DoLogLevel(const ALevel: TCommonLogLevel;
  const AMessage: string);
var
  tfOut: TextFile;
begin
  try
    AssignFile(tfOut, GetFileName);
    try
      Append (tfOut);
      WriteLn(tfOut, GetLevelName(ALevel) + DateTimeToStr(Now) + ' ' +  AMessage);
    finally
      CloseFile(tfOut);
    end;
  except
    //исхожу из того что логгирование - это второстепенная задача программы и то что
    //тут может быть ошибка не должно привести к ошибке для пользователя
  end;
end;

function TCommonLog.GetFileName: string;
var
  tfOut: TextFile;
begin
  Result := FCurrentFileName;
  if (FCurrentFileName <> '') and (FCurrentDate = Date) then exit;

  //Если файл не сохранялся то создаём и каталог log и файл с текущей датой
  FCurrentDate := Date;
  var sDir := TDirectory.GetCurrentDirectory + TPath.DirectorySeparatorChar + FFolderName;

  if not DirectoryExists(sDir) then
    CreateDir(sDir);

  FCurrentDate := Date;
  FCurrentFileName := sDir + TPath.DirectorySeparatorChar + FAppName + '_'+ FormatDateTime('yyyy-mm-dd', FCurrentDate) + '.log';
  if not FileExists(FCurrentFileName) then
  begin
    AssignFile(tfOut, FCurrentFileName);
    try
      ReWrite(tfOut);
    finally
      CloseFile(tfOut);
    end;
  end;

  Result := FCurrentFileName;
end;

function TCommonLog.GetLevelName(const ALevel: TCommonLogLevel): string;
begin
  if ALevel = cllInfo then
    Result := rsInfo + ': '
  else if ALevel = cllDebug then
    Result := rsDebug + ': '
  else if ALevel = cllWarning then
    Result := rsWarning + ': '
  else if ALevel = cllError then
    Result := rsError + ': '
  else if ALevel = cllFatalError then
    Result := rsFatalError + ': '
  else
    Result := rsUnknown + ': ';
end;

constructor TCommonLog.Create;
begin
  inherited;
  FUseLog          := C_DefaultUseLog;
  FLogLevel        := C_DefaultLogLevel;
  FAppName         := C_DefaultAppName;
  FFolderName      := C_DefaultFolderName;
  FCurrentDate     := Date;
  FCurrentFileName := '';
end;

procedure TCommonLog.Debug(const AMessage: string);
begin
  if CheckLogLevel(cllDebug) then
    DoLogLevel(cllDebug, AMessage);
end;

procedure TCommonLog.Error(const AMessage: string);
begin
  if CheckLogLevel(cllError) then
    DoLogLevel(cllError, AMessage);
end;

procedure TCommonLog.FatalError(const AMessage: string);
begin
  if CheckLogLevel(cllFatalError) then
    DoLogLevel(cllFatalError, AMessage);
end;

procedure TCommonLog.Info(const AMessage: string);
begin
  if CheckLogLevel(cllInfo) then
    DoLogLevel(cllInfo, AMessage);
end;

procedure TCommonLog.Warning(const AMessage: string);
begin
  if CheckLogLevel(cllWarning) then
    DoLogLevel(cllWarning, AMessage);
end;

initialization

finalization
  if Assigned(FLog) then
    FLog.Free;
end.