ulogger.pas

来自「FMA is a free1 powerful phone editing to」· PAS 代码 · 共 625 行 · 第 1/2 页

PAS
625
字号
unit uLogger;

{
*******************************************************************************
* Descriptions: Logger interfaces and implementation
* $Source: /cvsroot/fma/fma/uLogger.pas,v $
* $Locker:  $
*
* Todo:
*
* Change Log:
* $Log: uLogger.pas,v $
*
}

interface

uses
  Classes, SysUtils;

type
  TLogSeverity = (lsInformation, lsWarning, lsError, lsDebug);
  TLogSeverities = set of TLogSeverity;

  TLogCategory = (lcDefault, lcCommunication, lcSynchronization, lcScript);
  TLogCategories = set of TLogCategory;

const
  ALL_LOG_SEVERITIES = [lsInformation, lsWarning, lsError, lsDebug];
  ALL_LOG_CATEGORIES = [lcDefault, lcCommunication, lcSynchronization, lcScript];

type
  ILog = interface;

  ILogItem = interface
  ['{15C9713B-6002-4AA3-97FA-DD167491A0C6}']
    function GetIndex: Integer;
    function GetDateTime: TDateTime;
    function GetSeverity: TLogSeverity;
    function GetCategory: TLogCategory;
    function GetMessage: WideString;

    function SameAs(Item: ILogItem): Boolean;

    property Index: Integer read GetIndex;
    property DateTime: TDateTime read GetDateTime;
    property Severity: TLogSeverity read GetSeverity;
    property Category: TLogCategory read GetCategory;
    property Message: WideString read GetMessage;
  end;

  ILogEnumeration = interface
  ['{863DB63C-630D-4954-81DB-73625DE6C2B6}']
    function First: ILogItem;
    function Last: ILogItem;
    function Next(const Item: ILogItem): ILogItem;
    function Previous(const Item: ILogItem): ILogItem;

    function Contains(const Item: ILogItem): Boolean;
    function Log: ILog; 
  end;

  ILogObserver = interface
  ['{2CF9421E-DA76-40A5-AB29-725243F0AD91}']
    procedure LogChanged;
  end;

  ILog = interface
  ['{F66C2697-86CE-4562-8BCA-297656A48AD2}']
    procedure AddMessage(const Message: WideString; Severity: TLogSeverity = lsInformation; Category: TLogCategory = lcDefault);
    procedure AddMessageFmt(const Message: WideString; const Args: array of const; Severity: TLogSeverity = lsInformation; Category: TLogCategory = lcDefault);
    procedure AddCommunicationMessage(const Message: WideString; Severity: TLogSeverity = lsInformation);
    procedure AddCommunicationMessageFmt(const Message: WideString; const Args: array of const; Severity: TLogSeverity = lsInformation);
    procedure AddSynchronizationMessage(const Message: WideString; Severity: TLogSeverity = lsInformation);
    procedure AddSynchronizationMessageFmt(const Message: WideString; const Args: array of const; Severity: TLogSeverity = lsInformation);
    procedure AddScriptMessage(const Message: WideString; Severity: TLogSeverity = lsInformation);
    procedure AddScriptMessageFmt(const Message: WideString; const Args: array of const; Severity: TLogSeverity = lsInformation);

    function GetEnumeration(Severities: TLogSeverities = ALL_LOG_SEVERITIES; Categories: TLogCategories = ALL_LOG_CATEGORIES): ILogEnumeration;

    procedure Clear;

    procedure RegisterObserver(const Observer: ILogObserver);
    procedure UnregisterObserver(const Observer: ILogObserver);
  end;

var
  Log: ILog;

function CreateLog: ILog;

function LogSeverityToString(Severity: TLogSeverity): String;
function LogCategoryToString(Category: TLogCategory): String;

implementation


type
  TLogItem = record
    Index: Integer;
    DateTime: TDateTime;
    Severity: TLogSeverity;
    Category: TLogCategory;
    Message: WideString;
  end;
  PLogItem = ^TLogItem;

  TLog = class(TInterfacedObject, ILog)
  private
    FItems: TList;
    FItemsSynchronizer: TMultiReadExclusiveWriteSynchronizer;
    FObservers: TInterfaceList;
    FObserversSynchronizer: TMultiReadExclusiveWriteSynchronizer;
    function GetCount: Integer;
    function GetItem(Index: Integer): PLogItem;
  protected
    property Count: Integer read GetCount;
    property Items[Index: Integer]: PLogItem read GetItem;
    procedure BeginRead;
    procedure EndRead;
    procedure NotifyObserversLogChanged;
  public
    constructor Create;
    destructor Destroy; override;

    procedure AddMessage(const Message: WideString; Severity: TLogSeverity = lsInformation; Category: TLogCategory = lcDefault);
    procedure AddMessageFmt(const Message: WideString; const Args: array of const; Severity: TLogSeverity = lsInformation; Category: TLogCategory = lcDefault);
    procedure AddCommunicationMessage(const Message: WideString; Severity: TLogSeverity = lsInformation);
    procedure AddCommunicationMessageFmt(const Message: WideString; const Args: array of const; Severity: TLogSeverity = lsInformation);
    procedure AddSynchronizationMessage(const Message: WideString; Severity: TLogSeverity = lsInformation);
    procedure AddSynchronizationMessageFmt(const Message: WideString; const Args: array of const; Severity: TLogSeverity = lsInformation);
    procedure AddScriptMessage(const Message: WideString; Severity: TLogSeverity = lsInformation);
    procedure AddScriptMessageFmt(const Message: WideString; const Args: array of const; Severity: TLogSeverity = lsInformation);

    function GetEnumeration(Severities: TLogSeverities = ALL_LOG_SEVERITIES; Categories: TLogCategories = ALL_LOG_CATEGORIES): ILogEnumeration;

    procedure Clear;

    procedure RegisterObserver(const Observer: ILogObserver);
    procedure UnregisterObserver(const Observer: ILogObserver);
  end;

  TLogEnumeration = class(TInterfacedObject, ILogEnumeration)
  private
    FLog: TLog;
    FSeverities: TLogSeverities;
    FCategories: TLogCategories;
  protected
    function CreateLogItem(Item: PLogItem): ILogItem;
    function IsInFilter(Item: PLogItem): Boolean; virtual;
    function NextItemInFilter(Item: PLogItem): PLogItem;
    function PreviousItemInFilter(Item: PLogItem): PLogItem;
    function IsFiltered: Boolean;
  public
    constructor Create(ALog: TLog; ASeverities: TLogSeverities = ALL_LOG_SEVERITIES; ACategories: TLogCategories = ALL_LOG_CATEGORIES);

    function First: ILogItem;
    function Last: ILogItem;
    function Next(const Item: ILogItem): ILogItem;
    function Previous(const Item: ILogItem): ILogItem;

    function Contains(const Item: ILogItem): Boolean;
    function Log: ILog;
  end;

  TLogItemClass = class(TInterfacedObject, ILogItem)
  private
    FIndex: Integer;
    FDateTime: TDateTime;
    FSeverity: TLogSeverity;
    FCategory: TLogCategory;
    FMessage: WideString;

    function GetIndex: Integer;
  protected
    function GetDateTime: TDateTime;
    function GetSeverity: TLogSeverity;
    function GetCategory: TLogCategory;
    function GetMessage: WideString;
  public
    constructor Create(Item: PLogItem);

    function SameAs(Item: ILogItem): Boolean;
    
    property Index: Integer read GetIndex;
    property DateTime: TDateTime read GetDateTime;
    property Severity: TLogSeverity read GetSeverity;
    property Category: TLogCategory read GetCategory;
    property Message: WideString read GetMessage;
  end;

{ Global }

function CreateLog: ILog;
begin
  Result := TLog.Create;
end;

resourcestring
  SCategoryDefault = 'Default';
  SCategoryCommunication = 'Communication';
  SCategorySynchronization = 'Synchronization';
  SCategoryScript = 'Script';
  SCategoryUnknown = 'Unknown';

function LogCategoryToString(Category: TLogCategory): String;
begin
  case Category of
    lcDefault: Result := SCategoryDefault;
    lcCommunication: Result := SCategoryCommunication;
    lcSynchronization: Result := SCategorySynchronization;
    lcScript: Result := SCategoryScript;
    else Result := SCategoryUnknown;
  end;
end;

resourcestring
  SSeverityInformation = 'Information';
  SSeverityWarning = 'Warning';
  SSeverityError = 'Error';
  SSeverityDebug = 'Debug';
  SSeverityUnknown = 'Uknown';

function LogSeverityToString(Severity: TLogSeverity): String;
begin
  case Severity of
    lsInformation: Result := SSeverityInformation;
    lsWarning: Result := SSeverityWarning;
    lsError: Result := SSeverityError;
    lsDebug: Result := SSeverityDebug;
    else Result := SSeverityUnknown;
  end;
end;

{ TLog }

procedure TLog.AddSynchronizationMessage(const Message: WideString; Severity: TLogSeverity);
begin
  AddMessage(Message, Severity, lcSynchronization);
end;

procedure TLog.AddSynchronizationMessageFmt(const Message: WideString; const Args: array of const; Severity: TLogSeverity);
begin
  AddSynchronizationMessage(WideFormat(Message, Args), Severity);
end;

procedure TLog.AddMessage(const Message: WideString; Severity: TLogSeverity; Category: TLogCategory);
var
  Item: PLogItem;
  Index: Integer;
begin
  FItemsSynchronizer.BeginWrite;
  try
    New(Item);
    Index := FItems.Add(Item);

    Item.Index := Index;
    Item.DateTime := Now;
    Item.Severity := Severity;
    Item.Category := Category;
    Item.Message := Message;
  finally
    FItemsSynchronizer.EndWrite;
  end;

  NotifyObserversLogChanged;
end;

procedure TLog.AddMessageFmt(const Message: WideString; const Args: array of const; Severity: TLogSeverity; Category: TLogCategory);
begin
  AddMessage(WideFormat(Message, Args), Severity, Category);
end;

procedure TLog.AddCommunicationMessage(const Message: WideString; Severity: TLogSeverity);
begin
  AddMessage(Message, Severity, lcCommunication);
end;

procedure TLog.AddCommunicationMessageFmt(const Message: WideString; const Args: array of const; Severity: TLogSeverity);
begin
  AddCommunicationMessage(WideFormat(Message, Args), Severity);
end;

procedure TLog.AddScriptMessage(const Message: WideString; Severity: TLogSeverity);
begin
  AddMessage(Message, Severity, lcScript);
end;

procedure TLog.AddScriptMessageFmt(const Message: WideString; const Args: array of const; Severity: TLogSeverity);
begin
  AddScriptMessage(WideFormat(Message, Args), Severity);
end;

constructor TLog.Create;
begin
  inherited;

  FItems := TList.Create;
  FItems.Capacity := 100;
  FItemsSynchronizer := TMultiReadExclusiveWriteSynchronizer.Create;

  FObservers := TInterfaceList.Create;
  FObserversSynchronizer := TMultiReadExclusiveWriteSynchronizer.Create;
end;

destructor TLog.Destroy;
begin
  Clear;
  FItems.Free;
  FItemsSynchronizer.Free;

  FObservers.Free;
  FObserversSynchronizer.Free;

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?