MyLog.pas 4.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184
  1. {$I+}
  2. unit MyLog;
  3. {*******************************} interface {**********************************}
  4. var
  5. WriteTimeToLog :Boolean = False;
  6. WriteMillisecondsToLog :Boolean = False;
  7. LogElementsSeparator :String = ' ';
  8. Procedure WriteMyLog(const aStr :String);
  9. Procedure WriteMyLogEx(const aArgs :array of const; const aHeader :String = '');
  10. // WriteMyLogEx(['vMin',vMin,'vMax',vMax], 'Testing') -> Testing vMin=20 vMax=40
  11. {*****************************} implementation {*******************************}
  12. Uses
  13. System.SysUtils,
  14. System.Variants,
  15. System.IOUtils,
  16. System.SyncObjs,
  17. System.Diagnostics;
  18. var
  19. fInLog : TCriticalSection;
  20. fFS : TFormatSettings;
  21. fStopWatch : TStopwatch;
  22. fLogFile : TextFile;
  23. fLogOpened : Boolean;
  24. fFileBuf : array[1..4096] of Char;
  25. procedure AddStr(var aStr :String;const aAddStr :String);inline;
  26. begin
  27. aStr := aStr + aAddStr;
  28. end;
  29. Procedure WriteMyLog(const aStr :String);
  30. begin
  31. if not fLogOpened then
  32. Exit;
  33. var vFullStr :String;
  34. if WriteTimeToLog or WriteMillisecondsToLog then begin
  35. vFullStr := '[';
  36. if WriteTimeToLog then
  37. AddStr(vFullStr, DateTimeToStr(Now, fFS));
  38. if WriteMillisecondsToLog then begin
  39. if WriteTimeToLog then
  40. AddStr(vFullStr, '-');
  41. AddStr(vFullStr, IntToStr(fStopWatch.ElapsedMilliseconds));
  42. end;
  43. AddStr(vFullStr, ']' + aStr);
  44. end else
  45. vFullStr := aStr;
  46. fInLog.Acquire;
  47. try
  48. try
  49. Writeln(fLogFile, vFullStr);
  50. Flush(fLogFile);
  51. except
  52. //Ignoring all exceptions
  53. end;{try}
  54. finally
  55. fInLog.Release;
  56. end;
  57. end;
  58. function PointerToStr(aPtr : Pointer):String;
  59. begin
  60. if aPtr=nil then
  61. Exit('nil')
  62. else
  63. Exit(IntToHex(UIntPtr(aPtr)));
  64. end;
  65. function ObjectToStr(aObj : TObject):String;
  66. begin
  67. if aObj=nil then
  68. Exit('[]nil')
  69. else
  70. Exit('['+aObj.ClassName+']'+PointerToStr(aObj));
  71. end;
  72. Procedure WriteMyLogEx(const aArgs :array of const; const aHeader :String = '');
  73. var
  74. vArgument :Boolean;
  75. vStr :String;
  76. procedure IncStr(const aAddStr :String);
  77. begin
  78. if vArgument then
  79. AddStr(vStr, aAddStr)
  80. else
  81. AddStr(vStr, '=' + aAddStr + LogElementsSeparator);
  82. end;
  83. begin
  84. if not fLogOpened then
  85. Exit;
  86. vArgument := True;
  87. vStr := aHeader;
  88. if vStr<>'' then
  89. AddStr(vStr, LogElementsSeparator);
  90. for var I := Low(aArgs) to High(aArgs) do begin
  91. with aArgs[I] do begin
  92. case VType of
  93. vtUnicodeString : IncStr(String(UnicodeString(VUnicodeString)));
  94. vtAnsiString : IncStr(String(AnsiString(VAnsiString)));
  95. vtWideString : IncStr(String(WideString(VWideString)));
  96. vtString : IncStr(String(VString^));
  97. vtInteger : IncStr(IntToStr(VInteger));
  98. vtInt64 : IncStr(IntToStr(VInt64^));
  99. vtExtended : IncStr(FloatToStr(VExtended^, fFS));
  100. vtBoolean : IncStr(BoolToStr(VBoolean, true));
  101. vtCurrency : IncStr(CurrToStr(VCurrency^, fFS));
  102. vtObject : IncStr(ObjectToStr(VObject));
  103. vtClass : IncStr(VClass.ClassName);
  104. vtPointer : IncStr(PointerToStr(vPointer));
  105. vtVariant : IncStr(VarToStr(VVariant^));
  106. vtInterface : IncStr(PointerToStr(vInterface));
  107. (*
  108. vtChar
  109. vtPChar
  110. vtWideChar
  111. vtPWideChar
  112. *)
  113. end;{case}
  114. end;{with}
  115. vArgument := not vArgument;
  116. end;{for i}
  117. WriteMyLog(vStr);
  118. end;
  119. procedure InitLogSubSystem;
  120. begin
  121. fLogOpened := True;
  122. try
  123. var vTmpPath := TPath.GetTempPath + PathDelim + 'MyLog';
  124. CreateDir(vTmpPath);
  125. AddStr(vTmpPath, PathDelim + ExtractFileName(ParamStr(0)));
  126. var vLogFileName :String;
  127. var vInd := 0;
  128. repeat
  129. vLogFileName := vTmpPath + '.' + IntToStr(vInd) + '.log';
  130. inc(vInd);
  131. until not FileExists(vLogFileName);
  132. AssignFile(fLogFile, vLogFileName);
  133. System.SetTextBuf(fLogFile, fFileBuf);
  134. ReWrite(fLogFile);
  135. fInLog := TCriticalSection.Create;
  136. except
  137. fLogOpened := False;
  138. end;{try}
  139. if fLogOpened then begin
  140. fFS := FormatSettings;
  141. fFS.DecimalSeparator := '.';
  142. fFS.DateSeparator := '/';
  143. fFS.ShortDateFormat := 'dd/mm/yy';
  144. fFS.LongDateFormat := fFS.ShortDateFormat;
  145. fFS.TimeSeparator := ':';
  146. fFS.ShortTimeFormat := 'hh:nn:ss';
  147. fFS.LongTimeFormat := 'hh:nn:ss';
  148. fStopWatch := TStopwatch.StartNew;
  149. end;
  150. end;
  151. procedure DoneLogSystem;
  152. begin
  153. try
  154. if fLogOpened then begin
  155. fLogOpened := False;
  156. CloseFile(fLogFile);
  157. fInLog.Free;
  158. end;
  159. except
  160. {Ignoring}
  161. end;
  162. end;
  163. initialization
  164. InitLogSubSystem;
  165. WriteMyLog('===================== Start of log ============================');
  166. finalization
  167. WriteMyLog('===================== End of log ==============================');
  168. DoneLogSystem;
  169. end.