{$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.