Chip 2003 January/Chip_2003-01_cd1.bin/zkuste/delphi/unity/d56/FNDUTL.ZIP/System/cLog.pas

Pascal/Delphi Source File | 2002-10-29 | 13.3 KB | 419 lines

{$INCLUDE ..\cDefines.inc}
unit cLog;

interface

uses
  // Delphi
  SysUtils,
  Classes;



{                                                                              }
{                              Log unit v3.02                                  }
{                                                                              }
{        This unit is copyright ⌐ 2002 by David Butler ([e-mail])         }
{                                                                              }
{                  This unit is part of Delphi Fundamentals.                   }
{                     Its original file name is cLog.pas                       }
{       The latest version is available from the Fundamentals home page        }
{                     http://fundementals.sourceforge.net/                     }
{                                                                              }
{                I invite you to use this unit, free of charge.                }
{        I invite you to distibute this unit, but it must be for free.         }
{             I also invite you to contribute to its development,              }
{             but do not distribute a modified copy of this file.              }
{                                                                              }
{          A forum is available on SourceForge for general discussion          }
{             http://sourceforge.net/forum/forum.php?forum_id=2117             }
{                                                                              }
{                                                                              }
{ Revision history:                                                            }
{   2002/02/07  v2.01  Added TLog component from cDebug to cSysUtils.          }
{   2002/09/04  v3.02  Moved TLog component to cLog unit.                      }
{                                                                              }



{                                                                              }
{ Log Component                                                                }
{                                                                              }
{$TYPEINFO ON}
type
  TLogClass = (lcInfo, lcError, lcWarning, lcDebug, lcEndRepeat,
               lcUserEventBegin, lcUserEventEnd);
  TLogEvent = Procedure (const Sender : TObject; const LogClass : TLogClass;
      const LogMsg : String) of object;
  TLogEditMessageEvent = Procedure (const Sender : TObject; const LogClass : TLogClass;
      var LogMsg : String) of object;
  TLogFileEvent = Procedure (const Sender : TObject; const LogClass : TLogClass;
      var LogMsg : String; var LogToFile : Boolean) of object;
  TLogOptions = Set of (loLogToFile,           // Output log to a file
                        loKeepFileOpen,        // Keep log file open between messages
                        loLogToDebugLog,       // Log to system debug log (IDE)
                        loNoLogEvent,          // Don't generate log event
                        loLogDate,             // Include date in log message
                        loLogTime,             // Include time in log message
                        loLogMilliSecDiff,     // Include milliseconds since last log in message
                        loIgnoreLogFailure,    // Ignore log failures
                        loCheckRepeats,        // Log first and last of repeated messages
                        loIgnoreClassDebug,    // Ignore messages of class Debug
                        loIgnoreClassError,    // Ignore messages of class Error
                        loIgnoreClassWarning,  // Ignore messages of class Warning
                        loIgnoreClassInfo);    // Ignore messages of class Info
  TLog = class (TComponent)
    protected
    FOnLog          : TLogEvent;
    FOnEditMessage  : TLogEditMessageEvent;
    FOnLogFile      : TLogFileEvent;
    FLogFile        : TFileStream;
    FLogFileName    : String;
    FLogOptions     : TLogOptions;
    FLastLog        : Cardinal;
    FLastLogMsg     : String;
    FLogRepeatCount : Integer;
    FLogTo          : TLog;

    Procedure SetLogFileName (const LogFileName : String);
    Procedure SetLogOptions (const LogOptions : TLogOptions);
    Procedure SetLogTo (const LogTo : TLog);

    Procedure Init; virtual;
    Procedure RaiseError (const Msg : String);

    Procedure Notification (AComponent : TComponent; Operation : TOperation); override;

    Procedure TriggerLogMsg (const Sender : TObject; const LogClass : TLogClass;
              const LogMsg : String); virtual;
    Procedure Log (const LogClass : TLogClass; const LogMsg : String); overload;
    Procedure Log (const LogMsg : String); overload;
    Procedure LogDebug (const LogMsg : String);
    Procedure LogError (const LogMsg : String);
    Procedure LogWarning (const LogMsg : String);

    public
    Constructor Create (AOwner : TComponent); override;
    Destructor Destroy; override;

    Procedure Log (const Sender : TObject; const LogClass : TLogClass;
              const LogMsg : String); overload; virtual;

    Procedure DeleteLogFile;

    Procedure LoadLogFileInto (const Destination : TStrings; const Size : Integer = -1);

    Property  OnLog : TLogEvent read FOnLog write FOnLog;
    Property  OnEditMessage : TLogEditMessageEvent read FOnEditMessage write FOnEditMessage;
    Property  OnLogFile : TLogFileEvent read FOnLogFile write FOnLogFile;
    Property  LogFileName : String read FLogFileName write SetLogFileName;
    Property  LogOptions : TLogOptions read FLogOptions write SetLogOptions;
    Property  LogTo : TLog read FLogTo write SetLogTo;
  end;
  ELog = class (Exception);



{                                                                              }
{ Application Log                                                              }
{                                                                              }
Function  AppLog : TLog;



implementation

uses
  // Delphi
  Windows,

  // Fundamentals
  cUtils,
  cStrings;



{                                                                              }
{ Log Component                                                                }
{                                                                              }
Constructor TLog.Create (AOwner : TComponent);
  Begin
    inherited Create (AOwner);
    Init;
  End;

Destructor TLog.Destroy;
  Begin
    FreeAndNil (FLogFile);
    inherited Destroy;
  End;

Procedure TLog.Init;
  Begin
    FLogFileName := WithoutPrefix (ObjectClassName (self) + '.log', 'T');
    FLogOptions := [{$IFDEF DEBUG}loLogToDebugLog{$ENDIF}];
    {$IFDEF OS_MSWIN}
    FLastLog := GetTickCount;
    {$ENDIF}
  End;

Procedure TLog.RaiseError (const Msg : String);
  Begin
    raise ELog.Create (Msg);
  End;

Procedure TLog.Notification (AComponent : TComponent; Operation : TOperation);
  Begin
    inherited Notification (AComponent, Operation);
    if Operation = opRemove then
      if AComponent = FLogTo then
        FLogTo := nil;
  End;

Procedure TLog.SetLogFileName (const LogFileName : String);
  Begin
    if LogFileName = FLogFileName then
      exit;
    FreeAndNil (FLogFile);
    FLogFileName := LogFileName;
  End;

Procedure TLog.SetLogOptions (const LogOptions : TLogOptions);
  Begin
    if LogOptions = FLogOptions then
      exit;
    FLogOptions := LogOptions;
    if not (loLogToFile in LogOptions) or not (loKeepFileOpen in LogOptions) then
      FreeAndNil (FLogFile);
  End;

Procedure TLog.SetLogTo (const LogTo : TLog);
var L : TLog;
  Begin
    if LogTo = FLogTo then
      exit;
    if LogTo = nil then
      begin
        FLogTo := nil;
        exit;
      end;

    L := LogTo;
    Repeat
      if L = self then
        RaiseError ('Circular LogTo reference');
      L := L.FLogTo;
    Until not Assigned (L);

    FLogTo := LogTo;
  End;

Procedure TLog.TriggerLogMsg (const Sender : TObject; const LogClass : TLogClass; const LogMsg : String);
  Begin
  End;

Procedure TLog.Log (const Sender : TObject; const LogClass : TLogClass; const LogMsg : String);
var S : String;
    N : TDateTime;
    I : Integer;
    T : Cardinal;
    R, F : Boolean;
  Begin
    try
      if Assigned (FLogTo) then
        FLogTo.Log (Sender, LogClass, LogMsg);
    except
      if not (loIgnoreLogFailure in FLogOptions) then
        raise;
    end;

    Case LogClass of
      lcDebug   : if loIgnoreClassDebug in FLogOptions then exit;
      lcInfo    : if loIgnoreClassInfo in FLogOptions then exit;
      lcError   : if loIgnoreClassError in FLogOptions then exit;
      lcWarning : if loIgnoreClassWarning in FLogOptions then exit;
    end;

    try
      if loCheckRepeats in FLogOptions then
        begin
          if LogMsg = FLastLogMsg then
            begin
              Inc (FLogRepeatCount);
              exit;
            end;
          if FLogRepeatCount > 0 then
            begin
              I := FLogRepeatCount + 1;
              FLogRepeatCount := 0;
              Log (self, lcEndRepeat, IntToStr (I) + ' times');
            end;
          FLastLogMsg := LogMsg;
        end;

      S := LogMsg;
      if Assigned (FOnEditMessage) then
        FOnEditMessage (Sender, LogClass, S);

      if not (loNoLogEvent in FLogOptions) and Assigned (FOnLog) then
        FOnLog (Sender, LogClass, S);

      {$IFDEF OS_MSWIN}
      if loLogMilliSecDiff in FLogOptions then
        begin
          T := GetTickCount;
          S := PadLeft (IntToStr (T - FLastLog), ' ', 4, False) + ' ' + S;
          FLastLog := T;
        end;
      {$ENDIF}

      if [loLogDate, loLogTime] * FLogOptions <> [] then
        begin
          N := Now;
          if loLogTime in FLogOptions then
            S := FormatDateTime ('hhnnss', N) + ' ' + S;
          if loLogDate in FLogOptions then
            S := FormatDateTime ('yymmdd', N) + ' ' + S;
        end;

      TriggerLogMsg (Sender, LogClass, S);

      {$IFDEF OS_MSWIN}
      if loLogToDebugLog in FLogOptions then
        OutputDebugString (PChar (S));
      {$ENDIF}

      if loLogToFile in FLogOptions then
        begin
          if FLogFileName = '' then
            exit;
          F := True;
          if Assigned (FOnLogFile) then
            FOnLogFile (Sender, LogClass, S, F);
          if not F then
            exit;

          R := False;
          if not Assigned (FLogFile) then
            try
              FLogFile := TFileStream.Create (FLogFileName, fmOpenReadWrite);
              R := True;
            except
              FLogFile := TFileStream.Create (FLogFileName, fmCreate);
            end;
          if R then
            FLogFile.Seek (0, soFromEnd);

          try
            if S <> '' then
              FLogFile.Write (Pointer (S)^, Length (S));
            FLogFile.Write (CRLF, Length (CRLF));
          finally
            if not (loKeepFileOpen in FLogOptions) then
              FreeAndNil (FLogFile);
          end;
        end;
    except
      if not (loIgnoreLogFailure in FLogOptions) then
        raise;
    end;
  End;

Procedure TLog.Log (const LogClass : TLogClass; const LogMsg : String);
  Begin
    Log (self, LogClass, LogMsg);
  End;

Procedure TLog.Log (const LogMsg : String);
  Begin
    Log (lcInfo, LogMsg);
  End;

Procedure TLog.LogDebug (const LogMsg : String);
  Begin
    Log (lcDebug, LogMsg);
  End;

Procedure TLog.LogError (const LogMsg : String);
  Begin
    Log (lcError, LogMsg);
  End;

Procedure TLog.LogWarning (const LogMsg : String);
  Begin
    Log (lcWarning, LogMsg);
  End;

Procedure TLog.DeleteLogFile;
  Begin
    if FLogFileName = '' then
      exit;
    FreeAndNil (FLogFile);
    SysUtils.DeleteFile (FLogFileName);
  End;

Procedure TLog.LoadLogFileInto (const Destination : TStrings; const Size : Integer);
var S : Int64;
    C : Integer;
    L : String;
  Begin
    Destination.Clear;
    if Size = 0 then
      exit;

    FreeAndNil (FLogFile);
    try
      FLogFile := TFileStream.Create (FLogFileName, fmOpenReadWrite);
    except
      exit;
    end;

    S := FLogFile.Size;
    if S = 0 then
      exit;

    if Size < 0 then
      C := S else
      C := MinI (Size, S);
    FLogFile.Position := S - C;
    SetLength (L, C);
    FLogFile.Read (Pointer (L)^, C);

    // Remove incomplete first line
    TrimLeftInPlace (L, cs_AllChars - [#13, #10]);
    TrimLeftInPlace (L, [#13, #10]);

    Destination.Text := L;
  End;



{                                                                              }
{ Application Log                                                              }
{                                                                              }
var
  FAppLog : TLog = nil;

Function AppLog : TLog;
  Begin
    if not Assigned (FAppLog) then
      begin
        FAppLog := TLog.Create (nil);
        FAppLog.LogFileName := ChangeFileExt (ParamStr (0), '.log');
        FAppLog.LogOptions := [
            loLogToFile,
            loLogDate, loLogTime
            {$IFNDEF DEBUG}, loIgnoreLogFailure, loIgnoreClassDebug{$ENDIF}
                              ];
      end;
    Result := FAppLog;
  End;



initialization
finalization
  FreeAndNil (FAppLog);
end.