QuickLib/Quick.Log.pas

{ ***************************************************************************

  Copyright (c) 2016-2017 Kike Pérez

  Unit        : Quick.Log
  Description : Threadsafe Log
  Author      : Kike Pérez
  Version     : 1.17
  Created     : 10/04/2016
  Modified    : 17/09/2017

  This file is part of QuickLib: https://github.com/exilon/QuickLib

 ***************************************************************************

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

  http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.

 *************************************************************************** }

unit Quick.Log;

interface

uses
  Windows,
  Classes,
  Quick.Commons,
  System.SysUtils,
  System.IOUtils;

type

  TMemoryLog = class
  private
    fLines : TStrings;
    fText : string;
    fEnabled : Boolean;
    function GetLogText : string;
  public
    constructor Create;
    destructor Destroy; override;
    property Lines : TStrings read fLines write fLines;
    property Text : string read GetLogText;
    property Enabled : Boolean read fEnabled write fEnabled;
  end;

  TQuickLog = class
  private
    fLogFileName : string;
    fCurrentDateToFileName : Boolean;
    fHideHour : Boolean;
    fFMTName : string;
    fVerbose : TLogVerbose;
    fLimitLogSize : Int64;
    fCurrentLogSize : Int64;
    fShowEventTypes : Boolean;
    fShowHeaderInfo : Boolean;
    fCheckFileInUse : Boolean;
    fMemoryLog : TMemoryLog;
    function GetLogFileName : string;
    procedure WriteLog(cMsg : string);
  public
    property Verbose : TLogVerbose read fVerbose write fVerbose;
    property LogFileName : string read GetLogFileName;
    property HideHour : Boolean read fHideHour write fHideHour;
    property ShowEventType : Boolean read fShowEventTypes write fShowEventTypes;
    property ShowHeaderInfo : Boolean read fShowHeaderInfo write fShowHeaderInfo;
    property CheckFileInUse : Boolean read fCheckFileInUse write fCheckFileInUse;
    property MemoryLog : TMemoryLog read fMemoryLog write fMemoryLog;
    constructor Create;
    destructor Destroy; override;
    function SetLog(logname : string; AddCurrentDateToFileName : Boolean; LimitSizeInMB : Integer = 0) : Boolean;
    procedure Add(const cMsg : string; cEventType : TEventType = etInfo); overload;
    procedure Add(const cFormat : string; cParams : array of TVarRec ; cEventType : TEventType = etInfo); overload;
  end;

var
  CS : TRTLCriticalSection;
  Log : TQuickLog;

implementation


constructor TMemoryLog.Create;
begin
  inherited;
  fLines := TStringList.Create;
  fEnabled := False;
end;

destructor TMemoryLog.Destroy;
begin
  if Assigned(fLines) then fLines.Free;
  inherited;
end;

function TMemoryLog.GetLogText : string;
begin
  Result := fLines.Text;
end;


constructor TQuickLog.Create;
begin
  inherited;
  fVerbose := LOG_ALL;
  fLimitLogSize := 0;
  fShowEventTypes := True;
  fShowHeaderInfo := True;
  fCheckFileInUse := False;
  fMemoryLog := TMemoryLog.Create;
end;

destructor TQuickLog.Destroy;
begin
  if Assigned(fMemoryLog) then fMemoryLog.Free;
  inherited;
end;


{Returns date + time in english format (to add to filename}
function TQuickLog.GetLogFileName : string;
begin
  Result := '';
  if fCurrentDateToFileName then
  begin
    try
      //Checks if needs to show time or not
      if HideHour then Result := FormatDateTime('yyyymmdd', Now())
        else Result := FormatDateTime('yyyymmdd_hhmm', Now());
      Result := Format(fFMTName,[Result]);
    except
      Result := 'Error';
    end;
  end
  else Result := fLogFileName;
end;

function TQuickLog.SetLog(logname : string; AddCurrentDateToFileName : Boolean; LimitSizeInMB : Integer = 0) : Boolean;
begin
  if logname = '' then logname := TPath.GetDirectoryName(ParamStr(0)) + '\' + TPath.GetFileNameWithoutExtension(ParamStr(0)) + '.log';
  fFMTName := ExtractFilePath(logname) + ExtractFileNameWithoutExt(logname) + '_%s' + ExtractFileExt(logname);
  fHideHour := True;
  fCurrentDateToFileName := AddCurrentDateToFileName;
  fLogFileName := logname;
  //Checks if logfile is too big and deletes
  fLimitLogSize := LimitSizeInMB * 1024 * 1024;
  if (fLimitLogSize > 0) and (TFile.Exists(logname,True)) then
  begin
    try
      fCurrentLogSize := TFile.GetSize(logname);
      if fCurrentLogSize > fLimitLogSize Then if DeleteFile(logname) then fCurrentLogSize := 0;
    except
      raise Exception.Create('can''t access to log file!');
    end;
  end;
  //Checks if it's in use
  if (fCheckFileInUse) and (TFile.IsInUse(logname)) Then fLogFileName := Format('%s_(1).%s',[ExtractFileNameWithoutExt(logname),ExtractFileExt(logname)]);

  //writes header info
  if fShowHeaderInfo then
  begin
    Self.WriteLog(FillStr('-',70));
    Self.WriteLog(Format('Application : %s %s',[ExtractFilenameWithoutExt(ParamStr(0)),GetAppVersionFullStr]));
    Self.WriteLog(Format('Path        : %s',[ExtractFilePath(ParamStr(0))]));
    Self.WriteLog(Format('CPU cores   : %d',[CPUCount]));
    Self.WriteLog(Format('OS version  : %s',[TOSVersion.ToString]));
    Self.WriteLog(Format('Host        : %s',[GetComputerName]));
    Self.WriteLog(Format('Username    : %s',[Trim(GetLoggedUserName)]));
    Self.WriteLog(Format('Started     : %s',[NowStr]));
    if IsService then Self.WriteLog('AppType     : Service')
      else if System.IsConsole then Self.WriteLog('AppType     : Console');

    if IsDebug then Self.WriteLog('Debug mode  : On');
    Self.WriteLog(FillStr('-',70));
  end;
  Result := True;
end;

procedure TQuickLog.Add(const cMsg : string; cEventType : TEventType = etInfo);
begin
  //Check Log Verbose level
  if cEventType in fVerbose then
  begin
  if fShowEventTypes then Self.WriteLog(Format('%s [%s] %s',[DateTimeToStr(Now()),EventStr[Integer(cEventType)],cMsg]))
    else Self.WriteLog(Format('%s %s',[DateTimeToStr(Now()),cMsg]));
  end;
end;

procedure TQuickLog.WriteLog(cMsg : string);
var
  stream: TFileStream;
  logname : string;
  LBuffer      : TBytes;
  LByteOrderMark: TBytes;
  LOffset      : Integer;
  LEncoding, DestEncoding: TEncoding;
begin
  //Checks if need to add date to filename
  logname := GetLogFileName;
  EnterCriticalSection(CS);
  try
    cMsg := cMsg + #13#10;
    LEncoding:= TEncoding.Unicode;
    DestEncoding := TEncoding.Unicode;
    SetLength(LBuffer, length(cMsg) * sizeof(char));
    if cMsg <> '' then Move(cMsg[1], lbuffer[0], Length(lbuffer));
    LOffset := TEncoding.GetBufferEncoding(LBuffer, LEncoding);
    LBuffer := LEncoding.Convert(LEncoding, DestEncoding, LBuffer,
                                  LOffset, Length(LBuffer) - LOffset);

    if TFile.Exists(logname,True) then
    begin
      stream := TFileStream.Create(logname, fmOpenReadWrite or fmShareDenyWrite);
      stream.Position := stream.Size;
    end
    else
    begin
      stream := TFileStream.Create(logname, fmCreate or fmShareDenyWrite);
      LByteOrderMark := DestEncoding.GetPreamble;
      stream.Write(LByteOrderMark[0], Length(LByteOrderMark));
    end;

    with stream do
    begin
      try
        Write(LBuffer[0], Length(LBuffer));
        fCurrentLogSize := fCurrentLogSize + Length(LBuffer);
      finally
        Free;
      end;
    end;

    //writes internal log
    if fMemoryLog.Enabled then
    begin
      fMemoryLog.Lines.Add(cMsg);
    end;

    //check if limits max size
    try
      if (fLimitLogSize > 0) and (fCurrentLogSize > fLimitLogSize) then if DeleteFile(logname) then fCurrentLogSize := 0;
    except
      //
    end;
  finally
    LeaveCriticalSection(CS);
  end;
end;

procedure TQuickLog.Add(const cFormat : string; cParams : array of TVarRec ; cEventType : TEventType = etInfo);
begin
  Self.Add(Format(cFormat,cParams),cEventType);
end;

initialization
InitializeCriticalSection(CS);

finalization
DeleteCriticalSection(CS);

end.