Mega Code Archive

 
Categories / Delphi / Examples
 

Text based logging system

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.