Examples Delphi

Title: Text based logging system
Question: Very much a work in progress. Provides a thread safe, self truncating text based logging system. Provides different levels of logging (i.e. normal, verbose, warning, error). Only the normal and verbose work currently. I want to eventually build a logging system that can have plugins for database writing, HTML, etc. All options configurable via ini file but do default. Let me know how you think I can improve the code. Thanks!
Answer:
unit SW_txt_Log;
interface
uses classes, sysutils, windows, IniFiles, forms;
//Logging system defaults
const
INIFILENAME = 'swlog.ini';
SECTIONNAME = 'Settings'; //Ini section name
VERSION = 1.0; //Version of log
DEF_LOGFILENAME = 'c:\sw.txt'; //Name for log file
DEF_TEMPFILENAME = 'c:\sw.log'; //Used during truncation
//Defaults
DEF_INIFILENAME = 'sw.ini'; //Default name for log ini file
DEF_OVERWRITELOG = false; //Default to overwrite previous log
DEF_DEBUG = true; //Default to write to debug window
DEF_WRITETOFILE = true; //Default to write to file
DEF_MAXLOGSIZE = 2000; //This is the max size for the log
DEF_TRUNCATELOG = true; //This flag indicates if the log should ever be truncated
DEF_MAXBACK = 800; //During the truncate, how far to go back
DEF_VERBOSE_LOGGING = false; //do we want verbose logging on?
{************************************************************************8
Use these function when writing to the log
*********************************************************************}
procedure SWWriteLog(const msg: string); //regular log entry
procedure SWWriteLogE(const msg: string); //Error log entry
procedure SWWriteLogV(const msg: string); //Verbose Log entry
procedure SWWriteLogW(const msg: string); //Warning Log Entry
procedure SWWriteLogFmt(const msg: string; const Args: array of const);
procedure SWWriteLogVFmt(const msg: string; const Args: array of const);
type
ESWTxtLogException = class(Exception);
TSWTxtLog = class
private
FVersion: Double; // Version # of the log file In case we add more fields
FWriteToFile: Boolean; // Write to the disk log file?
FLogFileName: string; // File name for the log
FOverwriteLog: Boolean; // Overwrite the previous log entries?
FDebug: Boolean; // Generate Debug Window Messages
FLogFileCreated: Boolean; // Used to track if overwrite on when LogFile was created
FFs1: TFileStream;
FBuffer: string; //Holds current row in raw format
FEof: Boolean; //Eof?
FVersionChecked: Boolean; //Has version of log been checked?
FMaxLogSize: double; //The maximum size a log can be before truncation
FTruncateLog: boolean; //Should the log be truncated
FTempFileName: string; //Used during truncatelog entry
FVerboseLogging: Boolean;
procedure CreateLogFile;
procedure OpenLogFile;
procedure CloseLogFile;
procedure WriteVersion(fh: TFileStream);
procedure CheckVersion;
procedure ReadIni;
procedure ReadLn(fh: TFileStream);
procedure WriteLn(fh: TFileStream; const s: string);
procedure SetLogFileName(s: string);
procedure PerformTruncateLog;
public
constructor Create;
procedure Write(const s: string);
procedure Bottom(fh: TFileStream);
procedure Open;
procedure Close;
procedure WriteIni;
property LogFileName: string read FLogFileName write SetLogFileName;
property TruncateLog: Boolean read FTruncateLog write FTruncateLog;
property VerboseLogging: Boolean read FVerboseLogging;
end;
function SWTxtLog: TSWTxtLog;
implementation
var
ISWTxtLog: TSWTxtLog; // Internal singleton
SW_TXT_LOG_CS: TRTLCriticalSection;
function SWTxtLog: TSWTxtLog;
begin
if ISWTxtLog = nil then
ISWTxtLog := TSWTxtLog.Create;
result := ISWTxtLog;
end;
procedure SWWriteLog(const msg: string); //regular log entry
begin
SWTxtLog.Write(msg);
end;
procedure SWWriteLogE(const msg: string); //Error log entry
begin
SWTxtLog.Write(msg);
end;
procedure SWWriteLogV(const msg: string); //Verbose Log entry
begin
if SWTxtLog.VerboseLogging then
SWTxtLog.Write(msg);
end;
procedure SWWriteLogW(const msg: string); //Warning Log Entry
begin
SWTxtLog.Write(msg);
end;
procedure SWWriteLogFmt(const msg: string; const Args: array of const);
begin
SWWriteLog(format(msg, Args));
end;
procedure SWWriteLogVFmt(const msg: string; const Args: array of const);
begin
SWWriteLogV(format(msg, Args));
end;
constructor TSWTxtLog.Create;
begin
// inherited Create;
FLogFileCreated := false;
FEof := true;
FVersionChecked := false;
ReadIni;
end;
procedure TSWTxtLog.Write(const s: string);
var
t: string;
begin
t := t + FormatDateTime('mm/dd/yy hh:nn:ss', now) + ' - ';
t := t + s;
if FDebug then
OutputDebugString(Pchar(t));
EnterCriticalSection(SW_TXT_LOG_CS);
try
if FWriteToFile then begin
Open;
if (ffs1.Size FMaxLogSize) and (FTruncateLog) then begin
CloseLogFile;
PerformTruncateLog;
Open;
end;
Bottom(FFs1);
WriteLn(ffs1, t);
CloseLogFile;
end;
finally
LeaveCriticalSection(SW_TXT_LOG_CS);
end;
end;
procedure TSWTxtLog.WriteLn(fh: TFileStream; const s: string);
var
t: string;
begin
t := s + #13#10;
fh.Write(PChar(t)^, length(t));
end;
procedure TSWTxtLog.ReadIni;
var
t: TIniFile;
begin
t := TIniFile.Create(ExtractFilePath(Application.ExeName)+INIFILENAME);
try
FWriteToFile := t.ReadBool(SECTIONNAME, 'WriteToFile', DEF_WRITETOFILE);
FLogFileName := t.ReadString(SECTIONNAME, 'LogFileName', DEF_LOGFILENAME);
FOverwriteLog := t.ReadBool(SECTIONNAME, 'OverwriteLog', DEF_OVERWRITELOG);
FDebug := t.ReadBool(SECTIONNAME, 'Debug', DEF_DEBUG);
FMaxLogSize := strtofloat(t.ReadString(SECTIONNAME, 'MaxLogSize', FormatFloat('#################.##', DEF_MAXLOGSIZE)));
FTruncateLog := t.ReadBool(SECTIONNAME, 'TruncateLog', DEF_TRUNCATELOG);
FTempFileName := t.ReadString(SECTIONNAME, 'TempFileName', DEF_TEMPFILENAME);
FVerboseLogging := T.ReadBool(SECTIONNAME, 'VerboseLogging', DEF_VERBOSE_LOGGING);
finally
t.Free;
end; { try/finally }
end;
procedure TSWTxtLog.WriteIni;
var
t: TIniFile;
begin
t := TIniFile.Create(ExtractFilePath(Application.ExeName)+INIFILENAME);
try
t.WriteBool(SECTIONNAME, 'WriteToFile', FWriteToFile);
t.writeString(SECTIONNAME, 'LogFileName', FLogFileName);
t.writeBool(SECTIONNAME, 'OverwriteLog', FOverwriteLog);
t.writeBool(SECTIONNAME, 'Debug', FDebug);
t.writeString(SECTIONNAME, 'MaxLogSize', FormatFloat('#################.##', FMaxLogSize));
t.writeBool(SECTIONNAME, 'TruncateLog', FTruncateLog);
t.writeString(SECTIONNAME, 'TempFileName', FTempFileName);
T.WriteBool(SECTIONNAME, 'VerboseLogging', FVerboseLogging);
finally
t.Free;
end; { try/finally }
end;
procedure TSWTxtLog.CreateLogFile;
begin
try
FFs1 := TFileStream.create(FLogFileName, fmCreate);
FLogFileCreated := true;
except
raise ESWTxtLogException.CreateFmt('Error Creaing Log File:%s', [FLogFileName]);
end;
WriteVersion(FFs1);
end;
procedure TSWTxtLog.WriteVersion(fh: TFileStream);
begin
Writeln(fh, 'Version=' + FormatFloat('00.00', VERSION));
end;
procedure TSWTxtLog.CheckVersion;
begin
if not FVersionChecked then begin
FVersionChecked := true;
ReadLn(FFs1);
try
FVersion := strtofloat(copy(FBuffer, 9, 5));
if FVersion VERSION then
raise ESWTxtLogException.Create('old version');
except
begin
Close;
CreateLogFile;
Close;
write('OLD Version of Log deleted. New version created');
Open;
end;
end;
end;
end;
procedure TSWTxtLog.Open;
begin
if (FOverWriteLog) and (not FLogFileCreated) then
CreateLogFile
else begin
try
OpenLogFile;
CheckVersion; //ok it worked now check the version if not already checked
except
on e: EFOpenError do // if file doesn't exist then create it
CreateLogFile;
end;
end;
end;
procedure TSWTxtLog.OpenLogFile;
begin
FFs1 := TFileStream.create(FLogFileName, fmOpenReadWrite);
end;
procedure TSWTxtLog.CloseLogFile;
begin
FFs1.Free;
end;
procedure TSWTxtLog.Close;
begin
CloseLogFile;
end;
//Reads a line from a stream
procedure TSWTxtLog.ReadLn(fh: TFileStream);
var
c: char;
l: LongInt;
begin
FEof := false;
FBuffer := '';
l := fh.read(c, 1);
while (l 0) and (c #13) do begin
FBuffer := FBuffer + c;
l := fh.read(c, 1);
end;
if l 0 then
fh.read(c, 1) //skip #10
else
Feof := true;
end;
procedure TSWTxtLog.Bottom(fh: TFileStream);
begin
fh.Seek(0, soFromEnd);
end;
procedure TSWTxtLog.SetLogFileName(s: string);
begin
FLogFileName := s;
FLogFileCreated := false;
end;
procedure TSWTxtLog.PerformTruncateLog;
var
NFFs: TFileStream;
begin
Open;
NFFs := TFileStream.create(FTempFileName, fmCreate);
//Write Version out to new truncated log
WriteVersion(NFFs);
WriteLn(Nffs, 'Truncated log on:' + FormatDateTime('mm/dd/yy hh:nn:ss', now));
//Go back to the original
FFs1.seek(-DEF_MAXBACK, soFromEnd);
readln(FFs1); //Skip to next line
while not feof do begin
readln(FFs1);
if not feof then
writeln(Nffs, FBuffer);
end;
NFFs.Free;
Close;
sysutils.DeleteFile(FlogFileName);
RenameFile(FTempFileName, FLogFileName);
end;
initialization
ISWTxtLog := nil;
InitializeCriticalSection(SW_TXT_LOG_CS); // initialize my Critical section.
finalization
if ISWTxtLog nil then
ISWTxtLog.Free;
DeleteCriticalSection(SW_TXT_LOG_CS); // initialize my Critical section.
end.