| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203 |
- {$I+}
- unit MyLog;
- {*******************************} interface {**********************************}
- var
- UseAppendMode :Boolean = true;//One file mode. OLog file opened only in writing.
- WriteTimeToLog :Boolean = true;
- WriteMillisecondsToLog :Boolean = False;
- LogElementsSeparator :String = ' ';
- Procedure WriteMyLog(const aStr :String);
- Procedure WriteMyLogEx(const aArgs :array of const; const aHeader :String = '');
- // WriteMyLogEx(['vMin',vMin,'vMax',vMax], 'Testing') -> Testing vMin=20 vMax=40
- {*****************************} implementation {*******************************}
- Uses
- System.SysUtils,
- System.Variants,
- System.IOUtils,
- System.SyncObjs,
- System.Diagnostics;
- var
- fInLog : TCriticalSection;
- fFS : TFormatSettings;
- fStopWatch : TStopwatch;
- fLogFile : TextFile;
- fLogOpened : Boolean;
- fFileBuf : array[1..4096] of Char;
- fLogFileName : string;
- procedure AddStr(var aStr :String;const aAddStr :String);inline;
- begin
- aStr := aStr + aAddStr;
- end;
- Procedure WriteMyLog(const aStr :String);
- begin
- if not fLogOpened then
- Exit;
- var vFullStr :String;
- if WriteTimeToLog or WriteMillisecondsToLog then begin
- vFullStr := '[';
- if WriteTimeToLog then
- AddStr(vFullStr, DateTimeToStr(Now, fFS));
- if WriteMillisecondsToLog then begin
- if WriteTimeToLog then
- AddStr(vFullStr, '-');
- AddStr(vFullStr, IntToStr(fStopWatch.ElapsedMilliseconds));
- end;
- AddStr(vFullStr, ']' + aStr);
- end else
- vFullStr := aStr;
- fInLog.Acquire;
- try
- try
- if UseAppendMode then begin
- AssignFile(fLogFile, fLogFileName);
- if FileExists(fLogFileName) then
- Append(fLogFile)
- else
- Rewrite(fLogFile);
- try
- Writeln(fLogFile, vFullStr);
- finally
- CloseFile(fLogFile);
- end;
- end else begin
- Writeln(fLogFile, vFullStr);
- Flush(fLogFile);
- end;
- except
- //Ignoring all exceptions
- end;{try}
- finally
- fInLog.Release;
- end;
- end;
- function PointerToStr(aPtr : Pointer):String;
- begin
- if aPtr=nil then
- Exit('nil')
- else
- Exit(IntToHex(UIntPtr(aPtr)));
- end;
- function ObjectToStr(aObj : TObject):String;
- begin
- if aObj=nil then
- Exit('[]nil')
- else
- Exit('['+aObj.ClassName+']'+PointerToStr(aObj));
- end;
- Procedure WriteMyLogEx(const aArgs :array of const; const aHeader :String = '');
- var
- vArgument :Boolean;
- vStr :String;
- procedure IncStr(const aAddStr :String);
- begin
- if vArgument then
- AddStr(vStr, aAddStr)
- else
- AddStr(vStr, '=' + aAddStr + LogElementsSeparator);
- end;
- begin
- if not fLogOpened then
- Exit;
- vArgument := True;
- vStr := aHeader;
- if vStr<>'' then
- AddStr(vStr, LogElementsSeparator);
- for var I := Low(aArgs) to High(aArgs) do begin
- with aArgs[I] do begin
- case VType of
- vtUnicodeString : IncStr(String(UnicodeString(VUnicodeString)));
- vtAnsiString : IncStr(String(AnsiString(VAnsiString)));
- vtWideString : IncStr(String(WideString(VWideString)));
- vtString : IncStr(String(VString^));
- vtInteger : IncStr(IntToStr(VInteger));
- vtInt64 : IncStr(IntToStr(VInt64^));
- vtExtended : IncStr(FloatToStr(VExtended^, fFS));
- vtBoolean : IncStr(BoolToStr(VBoolean, true));
- vtCurrency : IncStr(CurrToStr(VCurrency^, fFS));
- vtObject : IncStr(ObjectToStr(VObject));
- vtClass : IncStr(VClass.ClassName);
- vtPointer : IncStr(PointerToStr(vPointer));
- vtVariant : IncStr(VarToStr(VVariant^));
- vtInterface : IncStr(PointerToStr(vInterface));
- (*
- vtChar
- vtPChar
- vtWideChar
- vtPWideChar
- *)
- end;{case}
- end;{with}
- vArgument := not vArgument;
- end;{for i}
- WriteMyLog(vStr);
- end;
- procedure InitLogSubSystem;
- begin
- fLogOpened := True;
- try
- var vTmpPath := TPath.GetTempPath + PathDelim + 'MyLog';
- CreateDir(vTmpPath);
- AddStr(vTmpPath, PathDelim + ExtractFileName(ParamStr(0)));
- if UseAppendMode then
- fLogFileName := vTmpPath + '.log'
- else begin
- var vInd := 0;
- repeat
- fLogFileName := vTmpPath + '.' + IntToStr(vInd) + '.log';
- inc(vInd);
- until not FileExists(fLogFileName);
- AssignFile(fLogFile, fLogFileName);
- System.SetTextBuf(fLogFile, fFileBuf);
- ReWrite(fLogFile);
- end;
- fInLog := TCriticalSection.Create;
- except
- fLogOpened := False;
- end;{try}
- if fLogOpened then begin
- fFS := FormatSettings;
- fFS.DecimalSeparator := '.';
- fFS.DateSeparator := '/';
- fFS.ShortDateFormat := 'dd/mm/yy';
- fFS.LongDateFormat := fFS.ShortDateFormat;
- fFS.TimeSeparator := ':';
- fFS.ShortTimeFormat := 'hh:nn:ss';
- fFS.LongTimeFormat := 'hh:nn:ss';
- fStopWatch := TStopwatch.StartNew;
- end;
- end;
- procedure DoneLogSystem;
- begin
- try
- if fLogOpened then begin
- fLogOpened := False;
- if not UseAppendMode then
- CloseFile(fLogFile);
- fInLog.Free;
- end;
- except
- {Ignoring}
- end;
- end;
- initialization
- InitLogSubSystem;
- WriteMyLog('===================== Start of log ============================');
- finalization
- WriteMyLog('===================== End of log ==============================');
- DoneLogSystem;
- end.
|