По сути работать должно во всех системах win и *nix - то на чём проверял, но, судя по коду TDirectory и TPath работать будет и на mac и на мобилках
Использование:
что стоит доделать:
- можно сделать запись в лог в отдельном потоке. только тогда надо научить ждать пока предыдущий поток не закончил запись
- чтение параметров логирования из какого-нибудь 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.