{*******************************************************}
{                                                       }
{       nrCommLib Communication Library for Delphi      }
{       Log file class (VCL)                            }
{       Copyright (c) 1997-2011 Roman Novgorodov        }
{       v9.27                                           }
{       last update: 28 Aug 2010                        }
{                                                       }
{       e-mail:noro@deepsoftware.com                    }
{       DeepSoftware                                    }
{       http://www.deepsoftware.com/                    }
{                                                       }
{*******************************************************}
{$I nrcommlib.inc}
unit nrlogfile;
interface
uses  nrclasses, windows, nrwin32, classes;
Type

  TLogOptions = set of(loSafeMode,loAutoFileName,loSharedLogFile,
                     loDate,loTime,loMSec,loDebugOut);

  TOnLogEntry = procedure(Sender:TObject; var logEntry:string) of object;

  TnrLogFile=class(TnrCustomLogFile)
  private
    Log:String;
    fSizeLimit: cardinal;
    fFileName: string;
    fDetailLevel: TDetailLevel;
    fOptions: TLogOptions;
    fLinesCount:integer;
    flAlreadyChecked:boolean;
    fReachLimit: TNotifyEvent;
    flVersion:boolean;
    fAnsiOnly:boolean;
    fOnLogEntry: TOnLogEntry;
    cs : TRTLCriticalSection;
    {$IFDEF NR_WITH_CONTROLS}
    fEdit: TCustomTerminal;
    procedure SetEdit(const Value: TCustomTerminal);
    function GetEdit:TCustomTerminal;
    {$ENDIF}
    function GetTrueFileName:string;
    //function WaitUnLock(ms:cardinal):boolean;
    function GetsizeLimit:cardinal;
    function GetFileName:string;

    function GetDetailLevel:TDetailLevel;
    function GetOptions:TLogOptions;
    function GetReachLimit:TNotifyEvent;
    procedure SetSizeLimit(const Value:cardinal);
    procedure SetFileName(const Value:string);
    procedure SetDetailLevel(const Value:TDetailLevel);
    procedure SetOptions(const Value:TLogOptions);
    procedure SetReachLimit(const Value:TNotifyEvent);
    function GetAnsiOnly: boolean;
    procedure SetAnsiOnly(const Value: boolean);
    function GetOnLogEntry: TOnLogEntry;
    procedure SetOnLogEntry(const Value: TOnLogEntry);

  protected
    function AddStringToFile(const s:string):boolean;
  public
    constructor Create(Owner:TComponent); override;
    destructor Destroy; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Save; override;
    procedure Clear;override;
    procedure Add(s:string); override;
    procedure AddSysInfo; override;
    procedure AddLog(const l:TDetailLevel; const s:string); override;
    procedure AddFmt(const Format: string; const Args: array of const); override;
    procedure AddLogFmt(const l:TDetailLevel;const Format: string; const Args: array of const);override;
  published
    property SizeLimit:cardinal read GetSizeLimit write SetSizeLimit;
    property FileName:string read GetFileName write SetFileName;
    {$IFDEF NR_WITH_CONTROLS}
    property VisualOut:TCustomTerminal read GetEdit write SetEdit;
    {$ENDIF}
    property DetailLevel:TDetailLevel  read GetDetailLevel write SetDetailLevel;
    property Options:TLogOptions       read GetOptions write SetOptions;
    property OnFatalError;
    property OnReachLimit:TNotifyEvent read GetReachLimit write SetReachLimit;
    property AnsiOnly:boolean read GetAnsiOnly write SetAnsiOnly;
    property OnLogEntry : TOnLogEntry read  GetOnLogEntry write SetOnLogEntry;
  end;

implementation

uses nrsysutils, sysutils;

{ TnrLogFile }

function TnrLogFile.AddStringToFile(const s:string):boolean;
label exitclose;
var hF:integer;
    sF:string;
    s2:AnsiString;
    n,dn,nn,ln:cardinal;
    pBuf:PChar;
    data:pointer;
begin

  EnterCriticalSection(cs);

  try
  Result := False;
  sF := Trim(GetTrueFileName);
  if sF='' then exit;
  nn := fmOpenReadWrite;

  if loSharedLogFile in Options
    then nn := nn or fmShareDenyWrite
    else nn := nn or fmShareExclusive;

  if not FileExists(sF)
    then hF := SysUtils.FileCreate(sF)
    else hF := SysUtils.FileOpen(sF,nn);

  if hF = -1 then exit;

  ln := Length(s);
  if not AnsiOnly then ln := ln * SizeOf(Char);

  if fSizeLimit > 0 then begin
    n := GetFileSize(hF,nil);
    if ln > fSizeLimit then ln := fSizeLimit;
    if(n + ln) > fSizeLimit then begin
      if Assigned(fReachLimit) then fReachLimit(Self);
      dn := (n + ln) - fSizeLimit;
      if FileSeek(hF,0,0) = -1 then goto exitclose;
      pBuf := StrAlloc(n);
      if dn < n then begin
        FileRead(hF, pBuf^, n);
        FileSeek(hF, 0, 0);
        FileWrite(hF, pBuf[dn], n - dn);
      end;
      SetEndOfFile(hF);
      StrDispose(pBuf);
    end;
  end;

  if AnsiOnly then begin
    s2 := AnsiString(s);
    data := @s2[1];
  end else data := @s[1];

  if FileSeek(hF, 0, 2) <> -1
    then Result := (FileWrite(hF, data^, ln) <> -1);

exitclose:
  FileClose(hF);
  finally
   LeaveCriticalSection(cs);
 end;
end;

constructor TnrLogFile.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  InitializeCriticalSection(cs);
//  cs := TCriticalSection.Create;
  fAnsiOnly := True;
  flVersion := True;
  fOptions := [loSafeMode,loAutoFileName,loDate,loTime,loDebugOut];
  fLinesCount := 0;
  fSizeLimit := 204800;

  flAlreadyChecked := False;
  fFileName := 'nrcommlib.log';
end;

destructor TnrLogFile.Destroy;
begin
//  WaitUnlock(1000);
  if not (loSafeMode in fOptions) then Save;
  DeleteCriticalSection(cs);
  inherited;
end;

{$IFDEF NR_WITH_CONTROLS}
procedure TnrLogFile.SetEdit(const Value: TCustomTerminal);
begin
  fEdit := Value;
  if Value<>nil then Value.FreeNotification(self);
end;

function TnrLogFile.GetEdit:TCustomTerminal;
begin
 Result := fEdit;
end;
{$ENDIF}

procedure TnrLogFile.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  {$IFDEF NR_WITH_CONTROLS}
  if Operation=opRemove then
    if AComponent=fEdit then fEdit:= nil;
  {$ENDIF}
end;

procedure TnrLogFile.Clear;
var sF:string;
begin
  Log := '';
  sF := GetTrueFileName;
  if sF = '' then exit;
  DeleteFile(sF);
end;

procedure TnrLogFile.Save;
var ss:string;
begin
  ss := GetTrueFileName;
  if ss <> '' then begin
    if AddStringToFile(Log)
      then Log := ''
      else DoFatalErrors(0, 0, 'Error when save log file:' + ss);
  end;

end;

procedure TnrLogFile.Add(s: string);
var ss:string;
    Dt:TDateTime;
    hr,min,sec,ms:word;
    i :integer;
begin

  EnterCriticalSection(cs);

  try

  if flVersion then begin
     flVersion := False;
     AddSysInfo;
//     exit;
  end;

  if Assigned(fOnLogEntry) then begin
    Try
      fOnLogEntry(self, s);
      if Length(s) = 0 then begin
        exit;
      end;
    except
    end;
  end;

  Dt := Now;
  ss := '';
  if loDate in fOptions then ss := DateToStr(Dt);
  if loTime in fOptions then ss := ss + ' ' + TimeToStr(Dt);
  if (loMSec in fOptions) then begin
    DecodeTime(Dt,hr,min,sec,ms);
    ss := Format('%s +%0.3d',[ss,ms]);
  end;
  if ss <> '' then ss := '[' + Trim(ss) + '] ';

  // convert nonprintable chars into the HEX codes ...
  for i := 1 to Length(s) do
    if s[i]<#$20
      then ss := ss + '\' + IntToHex(Byte(s[i]),2) + 'h'
      else ss := ss + s[i];
//  ss:=Format('%s%s',[ss,s]);

  if loDebugOut in Options then OutputDebugString(PChar(ss));

  ss := #13#10 + ss;
  Log := Log + ss;
  Inc(fLinesCount);
  {$IFDEF NR_WITH_CONTROLS}
  if Assigned(fEdit) then
    try
      fEdit.Text := fEdit.Text + ss;
    except
      DoFatalErrors(0,0,'');
    end;
  {$ENDIF}

  if loSafeMode in fOptions then Save;

  finally
    LeaveCriticalSection(cs);
  end;
end;

procedure TnrLogFile.AddSysInfo;
begin
  Add('nrComm Lib ' + nrCommLibVersion + ' ' +  nrCommLibEdition + ' ' +
  {$IFDEF TRIAL}
  ' (TRIAL! Please register!) ' +
  {$ENDIF}
  nrGetVersion('',''));
end;

procedure TnrLogFile.AddLog(const l:TDetailLevel; const s: string);
begin
  if l <= fDetailLevel then Add(s);
end;

procedure TnrLogFile.AddFmt(const Format: string; const Args: array of const);
var s:string;
begin
  try
    s := Sysutils.Format(Format, Args)
  except
    s := 'Log format ERROR!!!';
  end;
  Add(s);
end;

procedure TnrLogFile.AddLogFmt(const l: TDetailLevel; const Format: string;
  const Args: array of const);
begin
  if l <= fDetailLevel then AddFmt(Format,Args);
end;

function TnrLogFile.GetTrueFileName: string;
var s:string;
begin
  s := ParamStr(0);
  if not (loAutoFileName in fOptions) then begin
    if (fFileName <> '') and (Length(ExtractFilePath(fFileName)) < 2)
      then Result := ExtractFilePath(s) + fFileName
      else Result := fFileName;
  end else Result := ChangeFileExt(s, '.log');
end;

function TnrLogFile.GetSizeLimit: cardinal;
begin
  Result := fSizeLimit;
end;

function TnrLogFile.GetFileName: string;
begin
  Result := fFileName;
end;

function TnrLogFile.GetDetailLevel:TDetailLevel;
begin
  Result := fDetailLevel;
end;

function TnrLogFile.GetOptions:TLogOptions;
begin
  Result := fOptions;
end;

function TnrLogFile.GetReachLimit:TNotifyEvent;
begin
  Result := fReachLimit;
end;

procedure TnrLogFile.SetSizeLimit(const Value:cardinal);
begin
  fSizeLimit := Value;
end;

procedure TnrLogFile.SetFileName(const Value:string);
begin
  fFileName := Trim(Value);
end;

procedure TnrLogFile.SetDetailLevel(const Value:TDetailLevel);
begin
  fDetailLevel := Value;
end;

procedure TnrLogFile.SetOptions(const Value:TLogOptions);
begin
  fOptions := Value;
end;

procedure TnrLogFile.SetReachLimit(const Value:TNotifyEvent);
begin
  fReachLimit := Value;
end;

function TnrLogFile.GetAnsiOnly: boolean;
begin
  Result := fAnsiOnly;
end;

procedure TnrLogFile.SetAnsiOnly(const Value: boolean);
begin
  fAnsiOnly := Value;
end;

function TnrLogFile.GetOnLogEntry: TOnLogEntry;
begin
  Result := fOnLogEntry;
end;

procedure TnrLogFile.SetOnLogEntry(const Value: TOnLogEntry);
begin
  fOnLogEntry := Value;
end;

end.
