delphimvcframework/sources/Iocp.Logger.pas

{
  THIS UNIT IS A MODIFIED VERSION OF delphi-iocp-framework PROJECT
  You can find the original version here
  https://code.google.com/p/delphi-iocp-framework/
}
unit Iocp.Logger;

interface

uses
  Windows,
  Classes,
  SysUtils,
  SyncObjs,
  uGlobalVars,
  Iocp.Utils;

type
  TLogType = (ltNormal, ltWarning, ltError, ltException);
  TLogTypeSets = set of TLogType;

const
  LogTypeStr: array [TLogType] of string = ('ALL', 'WAR', 'ERR', 'EXP');

type
  TCacheFileStream = class(TThread)
  private
    FFileStream: TFileStream;
    FFileTime: TDateTime;
    FLocker: TCriticalSection;
    FCacheBuffer, FCacheBufferA, FCacheBufferB: TMemoryStream;
    FFlushInterval: DWORD;

  protected
    procedure Lock;
    procedure Unlock;

    procedure Execute; override;

  public
    constructor Create(const AFileName: string); reintroduce;
    destructor Destroy; override;

    function Write(const Buffer; Count: Longint): Longint;
    procedure AppendStr(const S: RawByteString); overload;
    procedure AppendStr(const S: UTF8String); overload;
    procedure AppendStr(const S: UnicodeString); overload;
    procedure Flush;

    property FileTime: TDateTime read FFileTime;
    property FlushInterval: DWORD read FFlushInterval write FFlushInterval;
  end;

  TIocpLogger = class
  private
    FRefCount: Integer;
    FFileWriters: array [TLogType] of TCacheFileStream;
    FFileLocker: array [TLogType] of TCriticalSection;
    FLogColor: array [TLogType] of Integer;
    FConsoleHandle: THandle;
    FShowConsole: Boolean;
    FConsoleLocker: TCriticalSection;
    procedure SetShowConsole(const Value: Boolean);

  protected
    function GetLogFileName(LogType: TLogType; Date: TDateTime): string;
    procedure AppendStrToLogFile(const S: UnicodeString; LogType: TLogType);

    function AddRef: Integer;
    function Release: Boolean;

  public
    constructor Create; virtual;
    destructor Destroy; override;

    procedure AppendLog(const Log: UnicodeString; const TimeFormat: string;
      LogType: TLogType = ltNormal; CRLF: string = ';'); overload;
    procedure AppendLog(const Log: UnicodeString; LogType: TLogType = ltNormal;
      CRLF: string = ';'); overload;
    procedure AppendLog(const Fmt: UnicodeString; const Args: array of const;
      const TimeFormat: string; LogType: TLogType = ltNormal; CRLF: string = ';'); overload;
    procedure AppendLog(const Fmt: UnicodeString; const Args: array of const;
      LogType: TLogType = ltNormal; CRLF: string = ';'); overload;

    property ShowConsole: Boolean read FShowConsole write SetShowConsole;
  end;

procedure ShowConsoleLog(OnOff: Boolean);
procedure AppendLog(const Log: UnicodeString; const TimeFormat: string;
  LogType: TLogType = ltNormal; CRLF: string = ';'); overload;
procedure AppendLog(const Log: UnicodeString; LogType: TLogType = ltNormal;
  CRLF: string = ';'); overload;
procedure AppendLog(const Fmt: UnicodeString; const Args: array of const; const TimeFormat: string;
  LogType: TLogType = ltNormal; CRLF: string = ';'); overload;
procedure AppendLog(const Fmt: UnicodeString; const Args: array of const;
  LogType: TLogType = ltNormal; CRLF: string = ';'); overload;

function gIocpLogger: TIocpLogger;

implementation

constructor TIocpLogger.Create;
var
  i: TLogType;
begin
  FRefCount := 1;

  for i := low(TLogType) to high(TLogType) do
  begin
    FFileLocker[i] := TCriticalSection.Create;
  end;

  FShowConsole := False;
  FConsoleHandle := INVALID_HANDLE_VALUE;
  FConsoleLocker := TCriticalSection.Create;

  { <EFBFBD><EFBFBD><EFBFBD><EFBFBD>̨<EFBFBD><EFBFBD>ɫ<EFBFBD><EFBFBD>

    FOREGROUND_INTENSITY - ǰ<EFBFBD><EFBFBD>ɫ<EFBFBD><EFBFBD><EFBFBD><EFBFBD>
    FOREGROUND_BLUE      - ǰ<EFBFBD><EFBFBD>ɫ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ
    FOREGROUND_GREEN     - ǰ<EFBFBD><EFBFBD>ɫ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ
    FOREGROUND_RED       - ǰ<EFBFBD><EFBFBD>ɫ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ

    BACKGROUND_INTENSITY - <EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ<EFBFBD><EFBFBD><EFBFBD><EFBFBD>
    BACKGROUND_BLUE      - <EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ
    BACKGROUND_GREEN     - <EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ
    BACKGROUND_RED       - <EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ<EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ

    <EFBFBD><EFBFBD>ɫ<EFBFBD><EFBFBD><EFBFBD><EFBFBD>ԭɫ<EFBFBD><EFBFBD><EFBFBD>϶<EFBFBD><EFBFBD><EFBFBD>
  }
  FLogColor[ltNormal] := FOREGROUND_RED or FOREGROUND_GREEN or FOREGROUND_BLUE;
  FLogColor[ltWarning] := FOREGROUND_INTENSITY or FOREGROUND_RED or FOREGROUND_GREEN;
  FLogColor[ltError] := FOREGROUND_INTENSITY or FOREGROUND_RED;
  FLogColor[ltException] := FOREGROUND_INTENSITY or FOREGROUND_RED or FOREGROUND_BLUE;
end;

destructor TIocpLogger.Destroy;
var
  i: TLogType;
begin
  for i := low(TLogType) to high(TLogType) do
  begin
    if Assigned(FFileWriters[i]) then
    begin
      FFileWriters[i].Flush;
      FFileWriters[i].Terminate;
      FFileWriters[i].Free;
      FFileWriters[i] := nil;
    end;
    FFileLocker[i].Free;
  end;
  FConsoleLocker.Free;

  inherited Destroy;
end;

function TIocpLogger.GetLogFileName(LogType: TLogType; Date: TDateTime): string;
begin
  Result := LogTypeStr[LogType];
  if (Result <> '') then
    Result := Result + '-';

{$IFDEF USEPIDFORLOGFILE}
  Result := Result + ThreadFormatDateTime('YYYY-MM-DD', Date) + '_PID' +
    IntToStr(GetCurrentProcessID) + '.log';

{$ELSE}
  Result := Result + ThreadFormatDateTime('YYYY-MM-DD', Date) + '.log';

{$ENDIF}

end;

function TIocpLogger.Release: Boolean;
begin
  Result := (InterlockedDecrement(FRefCount) = 0);

  if Result then
    Free;
end;

procedure TIocpLogger.SetShowConsole(const Value: Boolean);
var
  ConSize: TCoord;
  ConRec: TSmallRect;
begin
  if (FShowConsole = Value) then
    Exit;

  FShowConsole := Value;

  if FShowConsole then
  begin
    if (FConsoleHandle = INVALID_HANDLE_VALUE) then
    begin
      AllocConsole;
      FConsoleHandle := GetStdHandle(STD_OUTPUT_HANDLE);

      // <20><><EFBFBD>ÿ<EFBFBD><C3BF><EFBFBD>̨<EFBFBD><CCA8>Ļ<EFBFBD><C4BB><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>С<EFBFBD><D0A1>X=<3D><>(<28>ֽ<EFBFBD><D6BD><EFBFBD>), Y=<3D><>
      ConSize.X := 80;
      ConSize.Y := 8192;
      SetConsoleScreenBufferSize(FConsoleHandle, ConSize);

      // <20><><EFBFBD>ÿ<EFBFBD><C3BF><EFBFBD>̨λ<CCA8>ô<EFBFBD>С(<28><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ϊ<EFBFBD><CEAA>λ)
      ConRec.Left := 0;
      ConRec.Top := 0;
      ConRec.Right := 80 - 1;
      ConRec.Bottom := 25 - 1;
      SetConsoleWindowInfo(FConsoleHandle, True, ConRec);
    end;
  end
  else
  begin
    if (FConsoleHandle <> INVALID_HANDLE_VALUE) then
    begin
      FreeConsole;
      FConsoleHandle := INVALID_HANDLE_VALUE;
    end;
  end;
end;

procedure TIocpLogger.AppendLog(const Log: UnicodeString; const TimeFormat: string;
  LogType: TLogType; CRLF: string);
var
  LogText: UnicodeString;
begin
  if (AddRef = 1) then
    Exit;

  try
    if (CRLF <> '') then
      LogText := StringReplace(StringReplace(Log, #13#10, CRLF, [rfReplaceAll]), #10, CRLF,
        [rfReplaceAll])
    else
      LogText := Log;
    LogText := ThreadFormatDateTime(TimeFormat, Now) + ' ' + LogText + #13#10;

    if FShowConsole then
      try
        FConsoleLocker.Enter;
        SetConsoleTextAttribute(FConsoleHandle, FLogColor[LogType]);
        System.Write(LogText);
        SetConsoleTextAttribute(FConsoleHandle, FLogColor[ltNormal]);
      finally
        FConsoleLocker.Leave;
      end;

    AppendStrToLogFile(LogText, LogType);
  finally
    Release;
  end;
end;

procedure TIocpLogger.AppendLog(const Log: UnicodeString; LogType: TLogType; CRLF: string);
begin
  if (AddRef = 1) then
    Exit;
  try
    AppendLog(Log, 'HH:NN:SS:ZZZ', LogType, CRLF);
  finally
    Release;
  end;
end;

procedure TIocpLogger.AppendLog(const Fmt: UnicodeString; const Args: array of const;
  const TimeFormat: string; LogType: TLogType; CRLF: string);
begin
  if (AddRef = 1) then
    Exit;
  try
    AppendLog(ThreadFormat(Fmt, Args), TimeFormat, LogType, CRLF);
  finally
    Release;
  end;
end;

function TIocpLogger.AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount);
end;

procedure TIocpLogger.AppendLog(const Fmt: UnicodeString; const Args: array of const;
  LogType: TLogType; CRLF: string);
begin
  if (AddRef = 1) then
    Exit;
  try
    AppendLog(ThreadFormat(Fmt, Args), LogType, CRLF);
  finally
    Release;
  end;
end;

procedure TIocpLogger.AppendStrToLogFile(const S: UnicodeString; LogType: TLogType);
var
  LogDir, LogFile: string;
begin
  if (AddRef = 1) then
    Exit;
  try
    FFileLocker[LogType].Enter;
    try
      // CREATE OR ROTATE //daniele
      if not Assigned(FFileWriters[LogType]) or (Trunc(FFileWriters[LogType].FileTime) <> Trunc(Now))
      then
      begin
        if Assigned(FFileWriters[LogType]) then
        begin
          FFileWriters[LogType].Flush;
          FFileWriters[LogType].Terminate;
        end;

        LogDir := gAppPath + gAppName + '.Log\';
        LogFile := LogDir + GetLogFileName(LogType, Now);
        ForceDirectories(LogDir);
        FFileWriters[LogType] := TCacheFileStream.Create(LogFile);
      end;
    finally
      FFileLocker[LogType].Leave;
    end;

    FFileWriters[LogType].AppendStr(S);
  finally
    Release;
  end;
end;

{ TCacheFileStream }

procedure TCacheFileStream.AppendStr(const S: RawByteString);
begin
  write(S[1], Length(S));
end;

procedure TCacheFileStream.AppendStr(const S: UTF8String);
begin
  AppendStr(RawByteString(S));
end;

procedure TCacheFileStream.AppendStr(const S: UnicodeString);
begin
  AppendStr(UTF8Encode(S));
end;

constructor TCacheFileStream.Create(const AFileName: string);
var
  UTF8Header: RawByteString;
begin
  // <20><><EFBFBD>̴߳<DFB3><CCB4><EFBFBD>֮<EFBFBD>󴥷<EFBFBD><F3B4A5B7><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ļ<EFBFBD>ʧ<EFBFBD>ܵ<EFBFBD><DCB5>쳣<EFBFBD><ECB3A3><EFBFBD><EFBFBD><EFBFBD>ɳ<EFBFBD><C9B3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
  // <20><><EFBFBD>԰Ѵ<D4B0><D1B4><EFBFBD><EFBFBD>߳<EFBFBD>(inherited Create)<29><><EFBFBD>ڴ<EFBFBD><DAB4><EFBFBD><EFBFBD><EFBFBD>־<EFBFBD>ļ<EFBFBD>֮<EFBFBD><D6AE>
  if FileExists(AFileName) then
  begin
    FFileStream := TFileStream.Create(AFileName, fmOpenReadWrite or fmShareDenyWrite);
    UTF8Header := '';
  end
  else
  begin
    FFileStream := TFileStream.Create(AFileName, fmCreate);
    FFileStream.Free;
    FFileStream := TFileStream.Create(AFileName, fmOpenReadWrite or fmShareDenyWrite);
    // дUTF8<46>ļ<EFBFBD>ͷ
    UTF8Header := RawByteString(#$EF#$BB#$BF);
  end;

  inherited Create(True);

  // FreeOnTerminate := True;

  FLocker := TCriticalSection.Create;
  FCacheBufferA := TMemoryStream.Create;
  FCacheBufferB := TMemoryStream.Create;
  FCacheBuffer := FCacheBufferA;
  FFileTime := Now;
  FFlushInterval := 1000;

  if (UTF8Header <> '') then
    AppendStr(UTF8Header);

  Suspended := False;
end;

destructor TCacheFileStream.Destroy;
begin
  Lock;
  Flush; // daniele
  try
    if Assigned(FCacheBufferA) then
      FreeAndNil(FCacheBufferA);
    if Assigned(FCacheBufferB) then
      FreeAndNil(FCacheBufferB);
    if Assigned(FFileStream) then
      FreeAndNil(FFileStream);
  finally
    Unlock;
  end;
  if Assigned(FLocker) then
    FreeAndNil(FLocker);

  inherited Destroy;
end;

procedure TCacheFileStream.Execute;
begin
  // while not Terminated do
  // begin
  // if (CalcTickDiff(t, GetTickCount) >= FFlushInterval) then
  // begin
  // Flush;
  // t := GetTickCount;
  // end
  // else
  // SleepEx(100, True);
  // end;

  while not Terminated do
  begin
    Flush;
    TThread.Sleep(1000);
  end;

  // Flush;
end;

procedure TCacheFileStream.Flush;
var
  Buffer: TMemoryStream;
begin
  // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ǰ<EFBFBD><C7B0><EFBFBD><EFBFBD><EFBFBD><EFBFBD>û<EFBFBD><C3BB><EFBFBD><EFBFBD><EFBFBD>ݣ<EFBFBD><DDA3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>д<EFBFBD>ļ<EFBFBD>
  if (FCacheBuffer.Position <= 0) then
    Exit;

  // ˫<><CBAB><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ԣ<EFBFBD>
  // <20><>ȡ<EFBFBD><C8A1>ǰ<EFBFBD><C7B0><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ݣ<EFBFBD><DDA3><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>һ<EFBFBD><D2BB><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ϊ<EFBFBD><CEAA>ǰ<EFBFBD><C7B0><EFBFBD><EFBFBD>
  // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ҫ<EFBFBD><D2AA><EFBFBD><EFBFBD><EFBFBD><EFBFBD>TCacheFileStream.Write<74><65>Ҳ<EFBFBD><D2B2>Ҫ<EFBFBD><D2AA>ͬһ<CDAC><D2BB><EFBFBD><EFBFBD>
  Buffer := FCacheBuffer;
  Lock;
  if (FCacheBuffer = FCacheBufferA) then
    FCacheBuffer := FCacheBufferB
  else
    FCacheBuffer := FCacheBufferA;
  FCacheBuffer.Position := 0;
  Unlock;

  try
    // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>е<EFBFBD><D0B5><EFBFBD><EFBFBD><EFBFBD>׷<EFBFBD>ӵ<EFBFBD><D3B5>ļ<EFBFBD>β
    FFileStream.Seek(0, soEnd);
    FFileStream.Write(Buffer.Memory^, Buffer.Position);
    FlushFileBuffers(FFileStream.Handle);
  finally
    Buffer.Position := 0;
  end;
end;

procedure TCacheFileStream.Lock;
begin
  FLocker.Enter;
end;

procedure TCacheFileStream.Unlock;
begin
  FLocker.Leave;
end;

function TCacheFileStream.Write(const Buffer; Count: Integer): Longint;
begin
  Lock;
  try
    Result := FCacheBuffer.Write(Buffer, Count);
  finally
    Unlock;
  end;
end;

procedure ShowConsoleLog(OnOff: Boolean);
begin
  gIocpLogger.ShowConsole := OnOff;
end;

procedure AppendLog(const Log: UnicodeString; const TimeFormat: string;
  LogType: TLogType = ltNormal; CRLF: string = ';');
begin
  gIocpLogger.AppendLog(Log, TimeFormat, LogType, CRLF);
end;

procedure AppendLog(const Log: UnicodeString; LogType: TLogType = ltNormal; CRLF: string = ';');
begin
  gIocpLogger.AppendLog(Log, LogType, CRLF);
end;

procedure AppendLog(const Fmt: UnicodeString; const Args: array of const; const TimeFormat: string;
  LogType: TLogType = ltNormal; CRLF: string = ';');
begin
  gIocpLogger.AppendLog(Fmt, Args, TimeFormat, LogType, CRLF);
end;

procedure AppendLog(const Fmt: UnicodeString; const Args: array of const;
  LogType: TLogType = ltNormal; CRLF: string = ';');
begin
  gIocpLogger.AppendLog(Fmt, Args, LogType, CRLF);
end;

var
  _gIocpLogger: TIocpLogger;

function gIocpLogger: TIocpLogger;
begin
  { if (TInterlocked.CompareExchange<TIocpLogger>(_gIocpLogger, nil, nil) <> nil) then Exit(_gIocpLogger);

    Result := TIocpLogger.Create;
    TInterlocked.Exchange<TIocpLogger>(_gIocpLogger, Result); }

  Result := _gIocpLogger;
end;

initialization

_gIocpLogger := TIocpLogger.Create;

finalization

if Assigned(_gIocpLogger) then
  _gIocpLogger.Release;

end.