unit Basic_Logger;
{$mode objfpc}{$H+}
interface
uses
Classes,
SysUtils;
type
{ TLogger }
TLogger = class
private
FFileHandle : TextFile;
FFileName: String;
FSubDir: String;
FMaxFileSize: Int64;
procedure ValidationSize(const APath: String);
function GetFileSize(const AFileName: String): Int64;
strict private
function WriteStrings(const AMessage: string): Boolean;
protected
procedure Initialize();
procedure Finalize();
public
constructor Create(const AFileName: String; const ASubDir: String = 'Log'; const AMaxFileSize: Int64 = 100000);
destructor Destroy; override;
procedure LogError( ErrorMessage : string; Location : string );
procedure LogWarning( WarningMessage : string; Location : string );
procedure LogStatus( StatusMessage : string; Location : string );
end;
//inline access
function Logging: TLogger;
procedure FreeLogging;
implementation
Var
_Logging: TLogger;
function Logging: TLogger;
begin
if not(Assigned(_Logging)) then
_Logging:=TLogger.Create('');
Result:=_Logging;
end;
procedure FreeLogging;
begin
if Assigned(_Logging) then
FreeAndNil(_Logging);
end;
procedure TLogger.ValidationSize(const APath: String);
Var
I: Integer;
VFileSize: Int64;
begin
VFileSize:=0;
if FileExists(APath) then
begin
VFileSize:=GetFileSize(APath);
end;
if VFileSize > FMaxFileSize then
begin
I:=1;
while FileExists(APath+IntToStr(I)) do
begin
Inc(I);
end;
RenameFile(APath, APath+IntToStr(I));
end;
end;
function TLogger.GetFileSize(const AFileName: String): Int64;
var
// FileHandle: THandle;
fs: TStream;
begin
Result := -1;
fs := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
try
Result := fs.Size;
finally
fs.Free;
end;
{
FileHandle := FileOpen(AFileName, fmOpenRead or fmShareDenyNone);
if FileHandle <> THandle(-1) then
try
Result := FileSeek(FileHandle, 0, fsFromEnd);
finally
FileClose(FileHandle);
end;
}
end;
function TLogger.WriteStrings(const AMessage: string): Boolean;
begin
Result := False;
{$I-}
AssignFile(FFileHandle, FFileName);
if FileExists(FFileName) then
Append( FFileHandle )
else
Rewrite(FFileHandle);
{$I+}
if IOResult <> 0 then
Exit;
WriteLn( FFileHandle, AMessage );
Flush( FFileHandle );
CloseFile( FFileHandle );
Result := True;
end;
procedure TLogger.Initialize;
Var
VFileName: String;
VDir: String;
begin
VDir:=ExtractFilePath(ParamStr(0));
if FSubDir.Trim <> '' then
begin
VDir:=VDir+FSubDir;
VDir:=IncludeTrailingPathDelimiter(VDir);
end;
ForceDirectories(VDir);
if FFileName.Trim = '' then
FFileName:=ChangeFileExt( ExtractFileName( ParamStr(0) ), '.log' );
VFileName:=VDir+FFileName;
FFileName := VFileName;
ValidationSize(VFileName);
end;
procedure TLogger.Finalize();
begin
// CloseFile( FFileHandle );
end;
{ TLogger }
constructor TLogger.Create(const AFileName: String; const ASubDir: String;
const AMaxFileSize: Int64);
begin
FFileName:=AFileName;
FSubDir:=ASubDir;
if AMaxFileSize < 1 then
FMaxFileSize:=100000
else
FMaxFileSize:=AMaxFileSize;
Initialize();
end;
destructor TLogger.Destroy;
begin
Finalize();
inherited;
end;
procedure TLogger.LogError(ErrorMessage: string; Location: string);
var
S : string;
begin
S := '*** ERROR *** : @ ' + DateTimeToStr(Now) + ' MSG : ' + ErrorMessage + ' IN : ' + Location;
WriteStrings(S);
end;
procedure TLogger.LogStatus(StatusMessage: string; Location: string);
var
S : string;
begin
S := 'STATUS INFO : @ ' + DateTimeToStr(Now) + ' MSG : ' + StatusMessage + ' IN : ' + Location;
WriteStrings(S);
end;
procedure TLogger.LogWarning(WarningMessage: string; Location: string);
var
S : string;
begin
S := '=== WARNING === : @ ' + DateTimeToStr(Now) + ' MSG : ' + WarningMessage + ' IN : ' + Location;
WriteStrings(S);
end;
finalization
FreeLogging;
end.