Developer
662 lines
19 KiB
ObjectPascal
662 lines
19 KiB
ObjectPascal
unit uLogManager;
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Classes, System.JSON, System.Threading, System.Generics.Collections,
|
|
FMX.Forms, FMX.Controls, System.DateUtils;
|
|
|
|
type
|
|
TLogCategory = (lcSystem, lcNetwork, lcDatabase, lcBusiness, lcDevice, lcUI, lcSecurity, lcPerformance);
|
|
|
|
TLogCategories = set of TLogCategory;
|
|
|
|
TLogLevel = (llTrace, llDebug, llInfo, llWarn, llError, llFatal);
|
|
|
|
TLogEntry = record
|
|
Timestamp: TDateTime;
|
|
Level: TLogLevel;
|
|
Category: TLogCategory;
|
|
Message: string;
|
|
Tag: string;
|
|
UserID: string;
|
|
ThreadID: Cardinal;
|
|
procedure Clear;
|
|
end;
|
|
|
|
TOnLogEvent = reference to procedure(const LogEntry: TLogEntry);
|
|
|
|
TLogManager = class
|
|
private
|
|
FLogs: TList<TLogEntry>;
|
|
FMaxLogCount: Integer;
|
|
FEnabled: Boolean;
|
|
FCategories: TLogCategories;
|
|
FMinLevel: TLogLevel;
|
|
FOnLog: TOnLogEvent;
|
|
FLock: TObject;
|
|
FLogFileDir: string;
|
|
procedure AddLogInternal(const Entry: TLogEntry);
|
|
function GetLevelString(Level: TLogLevel): string;
|
|
function GetCategoryString(Category: TLogCategory): string;
|
|
public
|
|
constructor Create; virtual;
|
|
destructor Destroy; override;
|
|
procedure Log(Level: TLogLevel; Category: TLogCategory; const Message: string; const Args: array of const); overload;
|
|
procedure Log(Level: TLogLevel; Category: TLogCategory; const Message: string); overload;
|
|
procedure Trace(const Message: string; const Args: array of const); overload;
|
|
procedure Trace(const Message: string); overload;
|
|
procedure Debug(const Message: string; const Args: array of const); overload;
|
|
procedure Debug(const Message: string); overload;
|
|
procedure Info(const Message: string; const Args: array of const); overload;
|
|
procedure Info(const Message: string); overload;
|
|
procedure Warn(const Message: string; const Args: array of const); overload;
|
|
procedure Warn(const Message: string); overload;
|
|
procedure Error(const Message: string; const Args: array of const); overload;
|
|
procedure Error(const Message: string); overload;
|
|
procedure Fatal(const Message: string; const Args: array of const); overload;
|
|
procedure Fatal(const Message: string); overload;
|
|
procedure TraceCategory(Category: TLogCategory; const Message: string; const Args: array of const); overload;
|
|
procedure TraceCategory(Category: TLogCategory; const Message: string); overload;
|
|
procedure DebugCategory(Category: TLogCategory; const Message: string; const Args: array of const); overload;
|
|
procedure DebugCategory(Category: TLogCategory; const Message: string); overload;
|
|
procedure InfoCategory(Category: TLogCategory; const Message: string; const Args: array of const); overload;
|
|
procedure InfoCategory(Category: TLogCategory; const Message: string); overload;
|
|
procedure WarnCategory(Category: TLogCategory; const Message: string; const Args: array of const); overload;
|
|
procedure WarnCategory(Category: TLogCategory; const Message: string); overload;
|
|
procedure ErrorCategory(Category: TLogCategory; const Message: string; const Args: array of const); overload;
|
|
procedure ErrorCategory(Category: TLogCategory; const Message: string); overload;
|
|
procedure FatalCategory(Category: TLogCategory; const Message: string; const Args: array of const); overload;
|
|
procedure FatalCategory(Category: TLogCategory; const Message: string); overload;
|
|
procedure LogException(E: Exception; Category: TLogCategory; const AdditionalInfo: string = ''); overload;
|
|
procedure LogException(E: Exception; const AdditionalInfo: string = ''); overload;
|
|
procedure LogPerformance(const OperationName: string; const ElapsedMS: Int64);
|
|
procedure ClearLogs;
|
|
function GetLogs(Level: TLogLevel; Category: TLogCategory): TArray<TLogEntry>; overload;
|
|
function GetLogs(Level: TLogLevel; Categories: TLogCategories): TArray<TLogEntry>; overload;
|
|
function GetLogs(Level: TLogLevel = llTrace): TArray<TLogEntry>; overload;
|
|
function ExportToJSON: TJSONArray;
|
|
procedure SaveToFile(const FileName: string);
|
|
property Enabled: Boolean read FEnabled write FEnabled;
|
|
property Categories: TLogCategories read FCategories write FCategories;
|
|
property MinLevel: TLogLevel read FMinLevel write FMinLevel;
|
|
property MaxLogCount: Integer read FMaxLogCount write FMaxLogCount;
|
|
property OnLog: TOnLogEvent read FOnLog write FOnLog;
|
|
property LogFileDir: string read FLogFileDir write FLogFileDir;
|
|
procedure LogUIOperation(const UIOperation: string; const ControlName: string; const ElapsedMS: Int64 = -1);
|
|
procedure LogNetworkRequest(const URL: string; const Method: string; const StatusCode: Integer; const ElapsedMS: Int64);
|
|
procedure LogFormShow(const FormName: string; const ElapsedMS: Int64 = -1);
|
|
procedure LogFormClose(const FormName: string; const ElapsedMS: Int64 = -1);
|
|
procedure LogDataOperation(const Operation: string; const RecordCount: Integer; const ElapsedMS: Int64 = -1);
|
|
end;
|
|
|
|
TPerformanceLogger = class
|
|
private
|
|
FOperationName: string;
|
|
FStartTime: TDateTime;
|
|
FTag: string;
|
|
public
|
|
constructor Create(const AOperationName: string; ATag: string = '');
|
|
destructor Destroy; override;
|
|
procedure Finish;
|
|
procedure FinishWithInfo(const Info: string);
|
|
class function Measure<T>(const AOperationName: string; AFunc: TFunc<T>; ATag: string = ''): T;
|
|
class procedure MeasureProc(const AOperationName: string; AProc: TProc; ATag: string = '');
|
|
end;
|
|
|
|
TOperationContext = class
|
|
private
|
|
FUserID: string;
|
|
FSessionID: string;
|
|
FRequestID: string;
|
|
FStartTime: TDateTime;
|
|
FTags: TDictionary<string, string>;
|
|
public
|
|
constructor Create(const AUserID: string = '');
|
|
destructor Destroy; override;
|
|
procedure SetTag(const Key, Value: string);
|
|
function GetTag(const Key: string): string;
|
|
procedure ClearTags;
|
|
property UserID: string read FUserID write FUserID;
|
|
property SessionID: string read FSessionID write FSessionID;
|
|
property RequestID: string read FRequestID write FRequestID;
|
|
end;
|
|
|
|
function LogManager: TLogManager;
|
|
|
|
implementation
|
|
|
|
var
|
|
FLogManager: TLogManager;
|
|
|
|
function LogManager: TLogManager;
|
|
begin
|
|
if FLogManager = nil then
|
|
FLogManager := TLogManager.Create;
|
|
Result := FLogManager;
|
|
end;
|
|
|
|
{ TLogEntry }
|
|
|
|
procedure TLogEntry.Clear;
|
|
begin
|
|
Timestamp := 0;
|
|
Level := llTrace;
|
|
Category := lcSystem;
|
|
Message := '';
|
|
Tag := '';
|
|
UserID := '';
|
|
ThreadID := 0;
|
|
end;
|
|
|
|
{ TLogManager }
|
|
|
|
constructor TLogManager.Create;
|
|
begin
|
|
inherited;
|
|
FLogs := TList<TLogEntry>.Create;
|
|
FMaxLogCount := 10000;
|
|
FEnabled := True;
|
|
FCategories := [Low(TLogCategory)..High(TLogCategory)];
|
|
FMinLevel := llTrace;
|
|
FLock := TObject.Create;
|
|
FLogFileDir := ExtractFilePath(ParamStr(0)) + 'log\';
|
|
end;
|
|
|
|
destructor TLogManager.Destroy;
|
|
begin
|
|
FLogs.Free;
|
|
FLock.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TLogManager.AddLogInternal(const Entry: TLogEntry);
|
|
begin
|
|
TMonitor.Enter(FLock);
|
|
try
|
|
if FLogs.Count >= FMaxLogCount then
|
|
FLogs.Delete(0);
|
|
FLogs.Add(Entry);
|
|
finally
|
|
TMonitor.Exit(FLock);
|
|
end;
|
|
|
|
if Assigned(FOnLog) then
|
|
FOnLog(Entry);
|
|
end;
|
|
|
|
function TLogManager.GetLevelString(Level: TLogLevel): string;
|
|
begin
|
|
case Level of
|
|
llTrace: Result := '[TRACE]';
|
|
llDebug: Result := '[DEBUG]';
|
|
llInfo: Result := '[INFO]';
|
|
llWarn: Result := '[WARN]';
|
|
llError: Result := '[ERROR]';
|
|
llFatal: Result := '[FATAL]';
|
|
else
|
|
Result := '[UNKNOWN]';
|
|
end;
|
|
end;
|
|
|
|
function TLogManager.GetCategoryString(Category: TLogCategory): string;
|
|
begin
|
|
case Category of
|
|
lcSystem: Result := 'System';
|
|
lcNetwork: Result := 'Network';
|
|
lcDatabase: Result := 'Database';
|
|
lcBusiness: Result := 'Business';
|
|
lcDevice: Result := 'Device';
|
|
lcUI: Result := 'UI';
|
|
lcSecurity: Result := 'Security';
|
|
lcPerformance:Result := 'Performance';
|
|
else
|
|
Result := 'Unknown';
|
|
end;
|
|
end;
|
|
|
|
procedure TLogManager.Log(Level: TLogLevel; Category: TLogCategory; const Message: string; const Args: array of const);
|
|
var
|
|
Entry: TLogEntry;
|
|
begin
|
|
if not FEnabled then Exit;
|
|
if not (Category in FCategories) then Exit;
|
|
if Ord(Level) < Ord(FMinLevel) then Exit;
|
|
|
|
Entry.Timestamp := Now;
|
|
Entry.Level := Level;
|
|
Entry.Category := Category;
|
|
if Length(Args) > 0 then
|
|
Entry.Message := Format(Message, Args)
|
|
else
|
|
Entry.Message := Message;
|
|
Entry.Tag := '';
|
|
Entry.UserID := '';
|
|
Entry.ThreadID := TThread.CurrentThread.ThreadID;
|
|
|
|
AddLogInternal(Entry);
|
|
end;
|
|
|
|
procedure TLogManager.Log(Level: TLogLevel; Category: TLogCategory; const Message: string);
|
|
begin
|
|
Log(Level, Category, Message, []);
|
|
end;
|
|
|
|
procedure TLogManager.Trace(const Message: string; const Args: array of const);
|
|
begin
|
|
Log(llTrace, lcSystem, Message, Args);
|
|
end;
|
|
|
|
procedure TLogManager.Trace(const Message: string);
|
|
begin
|
|
Trace(Message, []);
|
|
end;
|
|
|
|
procedure TLogManager.Debug(const Message: string; const Args: array of const);
|
|
begin
|
|
Log(llDebug, lcSystem, Message, Args);
|
|
end;
|
|
|
|
procedure TLogManager.Debug(const Message: string);
|
|
begin
|
|
Debug(Message, []);
|
|
end;
|
|
|
|
procedure TLogManager.Info(const Message: string; const Args: array of const);
|
|
begin
|
|
Log(llInfo, lcSystem, Message, Args);
|
|
end;
|
|
|
|
procedure TLogManager.Info(const Message: string);
|
|
begin
|
|
Info(Message, []);
|
|
end;
|
|
|
|
procedure TLogManager.Warn(const Message: string; const Args: array of const);
|
|
begin
|
|
Log(llWarn, lcSystem, Message, Args);
|
|
end;
|
|
|
|
procedure TLogManager.Warn(const Message: string);
|
|
begin
|
|
Warn(Message, []);
|
|
end;
|
|
|
|
procedure TLogManager.Error(const Message: string; const Args: array of const);
|
|
begin
|
|
Log(llError, lcSystem, Message, Args);
|
|
end;
|
|
|
|
procedure TLogManager.Error(const Message: string);
|
|
begin
|
|
Error(Message, []);
|
|
end;
|
|
|
|
procedure TLogManager.Fatal(const Message: string; const Args: array of const);
|
|
begin
|
|
Log(llFatal, lcSystem, Message, Args);
|
|
end;
|
|
|
|
procedure TLogManager.Fatal(const Message: string);
|
|
begin
|
|
Fatal(Message, []);
|
|
end;
|
|
|
|
procedure TLogManager.TraceCategory(Category: TLogCategory; const Message: string; const Args: array of const);
|
|
begin
|
|
Log(llTrace, Category, Message, Args);
|
|
end;
|
|
|
|
procedure TLogManager.TraceCategory(Category: TLogCategory; const Message: string);
|
|
begin
|
|
TraceCategory(Category, Message, []);
|
|
end;
|
|
|
|
procedure TLogManager.DebugCategory(Category: TLogCategory; const Message: string; const Args: array of const);
|
|
begin
|
|
Log(llDebug, Category, Message, Args);
|
|
end;
|
|
|
|
procedure TLogManager.DebugCategory(Category: TLogCategory; const Message: string);
|
|
begin
|
|
DebugCategory(Category, Message, []);
|
|
end;
|
|
|
|
procedure TLogManager.InfoCategory(Category: TLogCategory; const Message: string; const Args: array of const);
|
|
begin
|
|
Log(llInfo, Category, Message, Args);
|
|
end;
|
|
|
|
procedure TLogManager.InfoCategory(Category: TLogCategory; const Message: string);
|
|
begin
|
|
InfoCategory(Category, Message, []);
|
|
end;
|
|
|
|
procedure TLogManager.WarnCategory(Category: TLogCategory; const Message: string; const Args: array of const);
|
|
begin
|
|
Log(llWarn, Category, Message, Args);
|
|
end;
|
|
|
|
procedure TLogManager.WarnCategory(Category: TLogCategory; const Message: string);
|
|
begin
|
|
WarnCategory(Category, Message, []);
|
|
end;
|
|
|
|
procedure TLogManager.ErrorCategory(Category: TLogCategory; const Message: string; const Args: array of const);
|
|
begin
|
|
Log(llError, Category, Message, Args);
|
|
end;
|
|
|
|
procedure TLogManager.ErrorCategory(Category: TLogCategory; const Message: string);
|
|
begin
|
|
ErrorCategory(Category, Message, []);
|
|
end;
|
|
|
|
procedure TLogManager.FatalCategory(Category: TLogCategory; const Message: string; const Args: array of const);
|
|
begin
|
|
Log(llFatal, Category, Message, Args);
|
|
end;
|
|
|
|
procedure TLogManager.FatalCategory(Category: TLogCategory; const Message: string);
|
|
begin
|
|
FatalCategory(Category, Message, []);
|
|
end;
|
|
|
|
procedure TLogManager.LogException(E: Exception; Category: TLogCategory; const AdditionalInfo: string);
|
|
var
|
|
Msg: string;
|
|
begin
|
|
if AdditionalInfo <> '' then
|
|
Msg := Format('%s [Additional: %s]', [E.Message, AdditionalInfo])
|
|
else
|
|
Msg := E.Message;
|
|
Log(llError, Category, 'Exception: %s: %s', [E.ClassName, Msg]);
|
|
end;
|
|
|
|
procedure TLogManager.LogException(E: Exception; const AdditionalInfo: string);
|
|
begin
|
|
LogException(E, lcSystem, AdditionalInfo);
|
|
end;
|
|
|
|
procedure TLogManager.LogPerformance(const OperationName: string; const ElapsedMS: Int64);
|
|
begin
|
|
Log(llInfo, lcPerformance, 'Operation [%s] took %d ms', [OperationName, Integer(ElapsedMS)]);
|
|
end;
|
|
|
|
procedure TLogManager.LogUIOperation(const UIOperation: string; const ControlName: string; const ElapsedMS: Int64);
|
|
begin
|
|
if ElapsedMS >= 0 then
|
|
Log(llInfo, lcUI, 'UI Operation [%s] on [%s] took %d ms', [UIOperation, ControlName, Integer(ElapsedMS)])
|
|
else
|
|
Log(llInfo, lcUI, 'UI Operation [%s] on [%s]', [UIOperation, ControlName]);
|
|
end;
|
|
|
|
procedure TLogManager.LogNetworkRequest(const URL: string; const Method: string; const StatusCode: Integer; const ElapsedMS: Int64);
|
|
begin
|
|
if (StatusCode >= 200) and (StatusCode < 300) then
|
|
Log(llInfo, lcNetwork, 'Network Request [%s] %s -> %d (%d ms)', [Method, URL, StatusCode, Integer(ElapsedMS)])
|
|
else if StatusCode >= 400 then
|
|
Log(llError, lcNetwork, 'Network Request [%s] %s -> %d (%d ms)', [Method, URL, StatusCode, Integer(ElapsedMS)])
|
|
else
|
|
Log(llWarn, lcNetwork, 'Network Request [%s] %s -> %d (%d ms)', [Method, URL, StatusCode, Integer(ElapsedMS)]);
|
|
end;
|
|
|
|
procedure TLogManager.LogFormShow(const FormName: string; const ElapsedMS: Int64);
|
|
begin
|
|
if ElapsedMS >= 0 then
|
|
Log(llInfo, lcUI, 'Form Show [%s] took %d ms', [FormName, Integer(ElapsedMS)])
|
|
else
|
|
Log(llInfo, lcUI, 'Form Show [%s]', [FormName]);
|
|
end;
|
|
|
|
procedure TLogManager.LogFormClose(const FormName: string; const ElapsedMS: Int64);
|
|
begin
|
|
if ElapsedMS >= 0 then
|
|
Log(llInfo, lcUI, 'Form Close [%s] took %d ms', [FormName, Integer(ElapsedMS)])
|
|
else
|
|
Log(llInfo, lcUI, 'Form Close [%s]', [FormName]);
|
|
end;
|
|
|
|
procedure TLogManager.LogDataOperation(const Operation: string; const RecordCount: Integer; const ElapsedMS: Int64);
|
|
begin
|
|
if ElapsedMS >= 0 then
|
|
Log(llInfo, lcDatabase, 'Data Operation [%s] (%d records) took %d ms', [Operation, RecordCount, Integer(ElapsedMS)])
|
|
else
|
|
Log(llInfo, lcDatabase, 'Data Operation [%s] (%d records)', [Operation, RecordCount]);
|
|
end;
|
|
|
|
procedure TLogManager.ClearLogs;
|
|
begin
|
|
TMonitor.Enter(FLock);
|
|
try
|
|
FLogs.Clear;
|
|
finally
|
|
TMonitor.Exit(FLock);
|
|
end;
|
|
end;
|
|
|
|
function TLogManager.GetLogs(Level: TLogLevel; Category: TLogCategory): TArray<TLogEntry>;
|
|
var
|
|
I, Count: Integer;
|
|
begin
|
|
TMonitor.Enter(FLock);
|
|
try
|
|
Count := 0;
|
|
for I := 0 to FLogs.Count - 1 do
|
|
begin
|
|
if (FLogs[I].Level = Level) and (FLogs[I].Category = Category) then
|
|
Inc(Count);
|
|
end;
|
|
SetLength(Result, Count);
|
|
Count := 0;
|
|
for I := 0 to FLogs.Count - 1 do
|
|
begin
|
|
if (FLogs[I].Level = Level) and (FLogs[I].Category = Category) then
|
|
begin
|
|
Result[Count] := FLogs[I];
|
|
Inc(Count);
|
|
end;
|
|
end;
|
|
finally
|
|
TMonitor.Exit(FLock);
|
|
end;
|
|
end;
|
|
|
|
function TLogManager.GetLogs(Level: TLogLevel; Categories: TLogCategories): TArray<TLogEntry>;
|
|
var
|
|
I, Count: Integer;
|
|
begin
|
|
TMonitor.Enter(FLock);
|
|
try
|
|
Count := 0;
|
|
for I := 0 to FLogs.Count - 1 do
|
|
begin
|
|
if (FLogs[I].Level >= Level) and (FLogs[I].Category in Categories) then
|
|
Inc(Count);
|
|
end;
|
|
SetLength(Result, Count);
|
|
Count := 0;
|
|
for I := 0 to FLogs.Count - 1 do
|
|
begin
|
|
if (FLogs[I].Level >= Level) and (FLogs[I].Category in Categories) then
|
|
begin
|
|
Result[Count] := FLogs[I];
|
|
Inc(Count);
|
|
end;
|
|
end;
|
|
finally
|
|
TMonitor.Exit(FLock);
|
|
end;
|
|
end;
|
|
|
|
function TLogManager.GetLogs(Level: TLogLevel): TArray<TLogEntry>;
|
|
var
|
|
I, Count: Integer;
|
|
begin
|
|
TMonitor.Enter(FLock);
|
|
try
|
|
Count := 0;
|
|
for I := 0 to FLogs.Count - 1 do
|
|
begin
|
|
if FLogs[I].Level >= Level then
|
|
Inc(Count);
|
|
end;
|
|
SetLength(Result, Count);
|
|
Count := 0;
|
|
for I := 0 to FLogs.Count - 1 do
|
|
begin
|
|
if FLogs[I].Level >= Level then
|
|
begin
|
|
Result[Count] := FLogs[I];
|
|
Inc(Count);
|
|
end;
|
|
end;
|
|
finally
|
|
TMonitor.Exit(FLock);
|
|
end;
|
|
end;
|
|
|
|
function TLogManager.ExportToJSON: TJSONArray;
|
|
var
|
|
I: Integer;
|
|
Entry: TJSONObject;
|
|
begin
|
|
Result := TJSONArray.Create;
|
|
TMonitor.Enter(FLock);
|
|
try
|
|
for I := 0 to FLogs.Count - 1 do
|
|
begin
|
|
Entry := TJSONObject.Create;
|
|
Entry.AddPair('timestamp', FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', FLogs[I].Timestamp));
|
|
Entry.AddPair('level', GetLevelString(FLogs[I].Level));
|
|
Entry.AddPair('category', GetCategoryString(FLogs[I].Category));
|
|
Entry.AddPair('message', FLogs[I].Message);
|
|
Entry.AddPair('threadId', TJSONNumber.Create(FLogs[I].ThreadID));
|
|
Result.AddElement(Entry);
|
|
end;
|
|
finally
|
|
TMonitor.Exit(FLock);
|
|
end;
|
|
end;
|
|
|
|
procedure TLogManager.SaveToFile(const FileName: string);
|
|
var
|
|
I: Integer;
|
|
Lines: TStringList;
|
|
Line: string;
|
|
begin
|
|
Lines := TStringList.Create;
|
|
try
|
|
TMonitor.Enter(FLock);
|
|
try
|
|
for I := 0 to FLogs.Count - 1 do
|
|
begin
|
|
Line := Format('%s %s [%s] %s',
|
|
[FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', FLogs[I].Timestamp),
|
|
GetLevelString(FLogs[I].Level),
|
|
GetCategoryString(FLogs[I].Category),
|
|
FLogs[I].Message]);
|
|
Lines.Add(Line);
|
|
end;
|
|
finally
|
|
TMonitor.Exit(FLock);
|
|
end;
|
|
if not ForceDirectories(ExtractFilePath(FileName)) then
|
|
Exit;
|
|
Lines.SaveToFile(FileName, TEncoding.UTF8);
|
|
finally
|
|
Lines.Free;
|
|
end;
|
|
end;
|
|
|
|
{ TPerformanceLogger }
|
|
|
|
constructor TPerformanceLogger.Create(const AOperationName: string; ATag: string);
|
|
begin
|
|
inherited Create;
|
|
FOperationName := AOperationName;
|
|
FStartTime := Now;
|
|
FTag := ATag;
|
|
end;
|
|
|
|
destructor TPerformanceLogger.Destroy;
|
|
begin
|
|
Finish;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TPerformanceLogger.Finish;
|
|
var
|
|
ElapsedMS: Int64;
|
|
begin
|
|
ElapsedMS := MilliSecondsBetween(Now, FStartTime);
|
|
LogManager.LogPerformance(FOperationName, ElapsedMS);
|
|
end;
|
|
|
|
procedure TPerformanceLogger.FinishWithInfo(const Info: string);
|
|
var
|
|
ElapsedMS: Int64;
|
|
begin
|
|
ElapsedMS := MilliSecondsBetween(Now, FStartTime);
|
|
LogManager.InfoCategory(lcPerformance, 'Operation [%s] with info [%s] took %d ms', [FOperationName, Info, Integer(ElapsedMS)]);
|
|
end;
|
|
|
|
class function TPerformanceLogger.Measure<T>(const AOperationName: string; AFunc: TFunc<T>; ATag: string): T;
|
|
var
|
|
StartTime: TDateTime;
|
|
begin
|
|
StartTime := Now;
|
|
try
|
|
Result := AFunc;
|
|
finally
|
|
LogManager.LogPerformance(AOperationName, MilliSecondsBetween(Now, StartTime));
|
|
end;
|
|
end;
|
|
|
|
class procedure TPerformanceLogger.MeasureProc(const AOperationName: string; AProc: TProc; ATag: string);
|
|
var
|
|
StartTime: TDateTime;
|
|
begin
|
|
StartTime := Now;
|
|
try
|
|
AProc;
|
|
finally
|
|
LogManager.LogPerformance(AOperationName, MilliSecondsBetween(Now, StartTime));
|
|
end;
|
|
end;
|
|
|
|
{ TOperationContext }
|
|
|
|
constructor TOperationContext.Create(const AUserID: string);
|
|
begin
|
|
inherited Create;
|
|
FUserID := AUserID;
|
|
FSessionID := '';
|
|
FRequestID := '';
|
|
FStartTime := Now;
|
|
FTags := TDictionary<string, string>.Create;
|
|
end;
|
|
|
|
destructor TOperationContext.Destroy;
|
|
begin
|
|
FTags.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TOperationContext.SetTag(const Key, Value: string);
|
|
begin
|
|
FTags.AddOrSetValue(Key, Value);
|
|
end;
|
|
|
|
function TOperationContext.GetTag(const Key: string): string;
|
|
begin
|
|
if not FTags.TryGetValue(Key, Result) then
|
|
Result := '';
|
|
end;
|
|
|
|
procedure TOperationContext.ClearTags;
|
|
begin
|
|
FTags.Clear;
|
|
end;
|
|
|
|
end. |