Delphi/delphimvcframework
1
0
Fork 0
mirror of https://github.com/danieleteti/delphimvcframework.git synced 2024-11-15 07:45:54 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Squashed 'lib/loggerpro/' changes from d490578b..b4faeb63

Browse Source 
b4faeb63 Added DBAppenderFireDAC sample. Small cleans to the code.
b0309600 Merge pull request #89 from fastbike/v2.0
80b27d35 Added DB logging appenders: FireDAC and dbGo (ADO). Includes a sample app using dbGO
08ae6ac0 Removed inline variable declaration to mantain compatibility with older delphi versions
1c4a6686 Merge remote-tracking branch 'origin/master' into v2.0
bf750989 Updated copyright
a94123c0 Added vertual method TLoggerProConsoleAppender.SetupColorMappings to customize colors in descendants
2a54eae4 Merge pull request #86 from TommiPrami/Typos
4bac0b9c Grammar fixed
2c447d5f Tiny Typos fixed

git-subtree-dir: lib/loggerpro
git-subtree-split: b4faeb63360010e36423d747949f4d378d659054
This commit is contained in:
Daniele Teti 2024-04-03 18:42:32 +02:00
parent 88cb06e717
commit 7aef2d3b88
35 changed files with 3314 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
LoggerPro.ConsoleAppender.pas
View File

@ -2,7 +2,7 @@
//
// LoggerPro
//
// Copyright (c) 2010-2023 Daniele Teti
// Copyright (c) 2010-2024 Daniele Teti
//
// https://github.com/danieleteti/loggerpro
//
@ -55,7 +55,10 @@ type
class constructor Create; // allocate global vars
class destructor Destroy;
protected
fColors: array [TLogType.Debug .. TLogType.Fatal] of Integer;
fSavedColors: Integer;
procedure SetColor(const Color: Integer);
procedure SetupColorMappings; virtual;
public
procedure Setup; override;
procedure TearDown; override;
@ -95,6 +98,17 @@ begin
SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE), Color);
end;
function GetCurrentColors: Integer;
var
info: CONSOLE_SCREEN_BUFFER_INFO;
begin
Result := -1;
if GetConsoleScreenBufferInfo(GetStdHandle(STD_OUTPUT_HANDLE), info) then
begin
Result := info.wAttributes;
end;
end;
procedure TLoggerProConsoleAppender.Setup;
begin
inherited;
@ -104,12 +118,16 @@ begin
try
if TInterlocked.Increment(TLoggerProConsoleAppender.FConsoleAllocated) = 1 then
begin
SetupColorMappings;
// Attempt to attach to the parent (if there is already a console allocated)
if not IsConsole then
begin
if not AttachConsole(ATTACH_PARENT_PROCESS) then
begin
AllocConsole; // No console allocated, create a new one
end;
end;
fSavedColors := GetCurrentColors;
TInterlocked.Increment(TLoggerProConsoleAppender.FConsoleAllocated);
end;
finally
@ -118,9 +136,21 @@ begin
end;
end;
procedure TLoggerProConsoleAppender.SetupColorMappings;
begin
fColors[TLogType.Debug] := FOREGROUND_GREEN;
fColors[TLogType.Info] := FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED;
fColors[TLogType.Warning] := FOREGROUND_RED or FOREGROUND_GREEN or FOREGROUND_INTENSITY;
fColors[TLogType.Error] := FOREGROUND_RED or FOREGROUND_INTENSITY;
fColors[TLogType.Fatal] := FOREGROUND_RED or FOREGROUND_BLUE or FOREGROUND_INTENSITY;
end;
procedure TLoggerProConsoleAppender.TearDown;
begin
if fSavedColors > -1 then
SetColor(fSavedColors)
else
SetColor(FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED);
end;
procedure TLoggerProConsoleAppender.WriteLog(const aLogItem: TLogItem);
@ -128,22 +158,8 @@ var
lText: string;
lColor: Integer;
begin
lColor := FOREGROUND_GREEN; // Avoid W1030
case aLogItem.LogType of
TLogType.Debug:
lColor := FOREGROUND_GREEN;
TLogType.Info:
lColor := FOREGROUND_BLUE or FOREGROUND_GREEN or FOREGROUND_RED;
TLogType.Warning:
lColor := FOREGROUND_RED or FOREGROUND_GREEN or FOREGROUND_INTENSITY;
TLogType.Error:
lColor := FOREGROUND_RED or FOREGROUND_INTENSITY;
TLogType.Fatal:
lColor := FOREGROUND_RED or FOREGROUND_BLUE or FOREGROUND_INTENSITY;
end;
lColor := fColors[aLogItem.LogType];
lText := FormatLog(aLogItem);
TLoggerProConsoleAppender.FLock.Enter;
try
SetColor(lColor);

85
LoggerPro.DBAppender.ADO.pas Normal file
View File

@ -0,0 +1,85 @@
unit LoggerPro.DBAppender.ADO;
// DB log appender - using dbGo aka ADO
interface
uses
System.Classes,
LoggerPro, System.SysUtils, Data.DB,
LoggerPro.DBAppender,
Data.Win.ADODB;
type
ESQLException = class(Exception)
private
FErrorCode: Integer;
public
constructor Create(AMessage: string; AErrorCode: Integer); overload;
constructor Create(StoredProc: TADOStoredProc); overload;
end;
/// <summary>LoggerPro that persists to DB via ADO stored procedure</summary>
TLoggerProDBAppenderADO = class(TLoggerProDBAppender<TADOStoredProc>)
protected
procedure RefreshParams(DataObj: TADOStoredProc); override;
procedure ExecuteDataObject(DataObj: TADOStoredProc); override;
public
procedure Setup; override;
procedure TearDown; override;
end;
implementation
uses
System.IOUtils, Winapi.ActiveX;
{ ESQLException }
constructor ESQLException.Create(AMessage: string; AErrorCode: Integer);
begin
inherited Create(AMessage);
FErrorCode := AErrorCode;
end;
constructor ESQLException.Create(StoredProc: TADOStoredProc);
var
LastErrorIdx: Integer;
begin
if StoredProc.Connection <> nil then
begin
LastErrorIdx := StoredProc.Connection.Errors.Count - 1;
Create(StoredProc.Connection.Errors.Item[LastErrorIdx].Description, StoredProc.Connection.Errors.Item[LastErrorIdx]
.NativeError);
end;
end;
{ TLoggerProDBAppenderADO }
procedure TLoggerProDBAppenderADO.ExecuteDataObject(DataObj: TADOStoredProc);
begin
DataObj.ExecProc;
if DataObj.Connection.Errors.Count > 0 then
raise ESQLException.Create(DataObj);
end;
procedure TLoggerProDBAppenderADO.RefreshParams(DataObj: TADOStoredProc);
begin
DataObj.Parameters.Refresh;
end;
procedure TLoggerProDBAppenderADO.Setup;
begin
CoInitialize(nil);
inherited;
end;
procedure TLoggerProDBAppenderADO.TearDown;
begin
inherited;
CoUninitialize;
end;
end.

39
LoggerPro.DBAppender.FireDAC.pas Normal file
View File

@ -0,0 +1,39 @@
unit LoggerPro.DBAppender.FireDAC;
// DB log appender for FireDAC
interface
uses
System.Classes,
LoggerPro, System.SysUtils, Data.DB,
LoggerPro.DBAppender,
FireDAC.Stan.Error,
FireDAC.DApt,
FireDAC.Phys,
FireDAC.Stan.Param,
FireDAC.Comp.Client;
type
/// <summary>LoggerPro that persists to DB via a FireDAC stored procedure</summary>
TLoggerProDBAppenderFireDAC = class(TLoggerProDBAppender<TFDStoredProc>)
protected
procedure RefreshParams(DataObj: TFDStoredProc); override;
procedure ExecuteDataObject(DataObj: TFDStoredProc); override;
end;
implementation
{ TLoggerProDBAppenderFireDAC }
procedure TLoggerProDBAppenderFireDAC.ExecuteDataObject(DataObj: TFDStoredProc);
begin
DataObj.ExecProc;
end;
procedure TLoggerProDBAppenderFireDAC.RefreshParams(DataObj: TFDStoredProc);
begin
DataObj.Prepare;
end;
end.

142
LoggerPro.DBAppender.pas Normal file
View File

@ -0,0 +1,142 @@
unit LoggerPro.DBAppender;
// Abstract LoggerPro Appender that writes to a database
// Subclass to use with DB connection stack of choice e.g. ADO, FireDAC etc
// only supports parameterised stored procedures for security and performance
interface
uses
System.Classes, LoggerPro, System.SysUtils, Data.DB;
type
TOnDBWriteError = reference to procedure(const Sender: TObject; const LogItem: TLogItem; const DBError: Exception;
var RetryCount: Integer);
TGetDBConnection = reference to function: TCustomConnection;
TGetStoredProc<T: class> = reference to function(Connection: TCustomConnection): T;
TSetParams<T: class> = reference to procedure(DataObject: T; LogItem: TLogItem);
///<summary>Abstract class for writing logs to database</summary>
/// <remarks>Subclass with your choice of stored procedure class to get a working logger </remarks>
TLoggerProDBAppender<T: class> = class(TLoggerProAppenderBase)
protected
const MAX_RETRY_COUNT = 5;
protected
FOnDBWriteError: TOnDBWriteError;
FGetDBConnection: TGetDBConnection;
FGetStoredProc: TGetStoredProc<T>;
FSetParams: TSetParams<T>;
FDBConnection: TCustomConnection;
FDBObject: T;
procedure RefreshParams(DataObj: T); virtual; abstract;
procedure ExecuteDataObject(DataObj: T); virtual; abstract;
public
constructor Create(GetDBConnection: TGetDBConnection; GetStoredProc: TGetStoredProc<T>; SetParams: TSetParams<T>;
OnDBWriteError: TOnDBWriteError); reintroduce;
procedure Setup; override;
procedure TearDown; override;
procedure TryToRestart(var Restarted: Boolean); override;
procedure WriteLog(const ALogItem: TLogItem); override;
end;
implementation
{ TLoggerProDBAppender }
///<summary>Create an instance of the DB logger</summary>
/// <param name="GetDBConnection">anonymous function that returns a configured DB Connection</param>
/// <param name="GetStoredProc">anonymous function that returns a stored proc that can write to the DB</param>
/// <param name="SetParams">anonymous procedure that populates parameters before the stored proc is executed</param>
/// <param name="OnDBWriteError">anonymous procedure to handle retry of a failed operaation</param>
constructor TLoggerProDBAppender<T>.Create(GetDBConnection: TGetDBConnection; GetStoredProc: TGetStoredProc<T>;
SetParams: TSetParams<T>; OnDBWriteError: TOnDBWriteError);
begin
inherited Create;
FGetDBConnection := GetDBConnection;
FGetStoredProc := GetStoredProc;
FSetParams := SetParams;
FOnDBWriteError := OnDBWriteError;
end;
procedure TLoggerProDBAppender<T>.Setup;
begin
inherited;
FDBConnection := FGetDBConnection;
end;
procedure TLoggerProDBAppender<T>.TearDown;
begin
inherited;
if FDBObject <> nil then
FDBObject.Free;
if FDBConnection <> nil then
begin
FDBConnection.Connected := False;
FDBConnection.Free;
end;
end;
procedure TLoggerProDBAppender<T>.TryToRestart(var Restarted: Boolean);
begin
try
// remove the DB Object
if FDBObject <> nil then
begin
FDBObject.Free;
FDBObject := nil;
end;
// reset the DB connection
if FDBConnection <> nil then
begin
FDBConnection.Connected := False;
FDBConnection.Free;
FDBConnection := nil;
end;
except
// no point catching the exception
end;
// now try to restart it
FDBConnection := FGetDBConnection;
Restarted := True;
end;
procedure TLoggerProDBAppender<T>.WriteLog(const ALogItem: TLogItem);
var
RetryCount: Integer;
begin
RetryCount := 0;
repeat
try
if FDBObject = nil then
begin
FDBConnection.Connected := True; //force an exception if needed
FDBObject := FGetStoredProc(FDBConnection);
RefreshParams(FDBObject); //this may not raise unhandled exception even in case of disconnection
end;
FSetParams(FDBObject, ALogItem);
ExecuteDataObject(FDBObject);
Break;
except
on E: Exception do
begin
// if there is an event handler for DB exception, call it
if Assigned(FOnDBWriteError) then
FOnDBWriteError(Self, ALogItem, E, RetryCount);
Inc(RetryCount);
// if the handler has set FRetryCount to a positive value then retry the call
if RetryCount >= MAX_RETRY_COUNT then
raise;
end;
end;
until False;
end;
end.

2
LoggerPro.DMSEventStreamsAppender.pas
View File

@ -2,7 +2,7 @@
//
// LoggerPro
//
// Copyright (c) 2010-2023 Daniele Teti
// Copyright (c) 2010-2024 Daniele Teti
//
// https://github.com/danieleteti/loggerpro
//

2
LoggerPro.EMailAppender.pas
View File

@ -2,7 +2,7 @@
//
// LoggerPro
//
// Copyright (c) 2010-2023 Daniele Teti
// Copyright (c) 2010-2024 Daniele Teti
//
// https://github.com/danieleteti/loggerpro
//

2
LoggerPro.ElasticSearchAppender.pas
View File

@ -2,7 +2,7 @@
//
// LoggerPro
//
// Copyright (c) 2010-2023 Daniele Teti
// Copyright (c) 2010-2024 Daniele Teti
//
// https://github.com/danieleteti/loggerpro
//

2
LoggerPro.FileAppender.pas
View File

@ -2,7 +2,7 @@
//
// LoggerPro
//
// Copyright (c) 2010-2023 Daniele Teti
// Copyright (c) 2010-2024 Daniele Teti
//
// https://github.com/danieleteti/loggerpro
//

2
LoggerPro.GlobalLogger.pas
View File

@ -2,7 +2,7 @@
//
// LoggerPro
//
// Copyright (c) 2010-2023 Daniele Teti
// Copyright (c) 2010-2024 Daniele Teti
//
// https://github.com/danieleteti/loggerpro
//

2
LoggerPro.Proxy.pas
View File

@ -2,7 +2,7 @@
//
// LoggerPro
//
// Copyright (c) 2010-2023 Daniele Teti
// Copyright (c) 2010-2024 Daniele Teti
//
// https://github.com/danieleteti/loggerpro
//

2
LoggerPro.RESTAppender.pas
View File

@ -2,7 +2,7 @@
//
// LoggerPro
//
// Copyright (c) 2010-2023 Daniele Teti
// Copyright (c) 2010-2024 Daniele Teti
//
// https://github.com/danieleteti/loggerpro
//

2
LoggerPro.RedisAppender.pas
View File

@ -2,7 +2,7 @@
//
// LoggerPro
//
// Copyright (c) 2010-2023 Daniele Teti
// Copyright (c) 2010-2024 Daniele Teti
//
// https://github.com/danieleteti/loggerpro
//

2
LoggerPro.UDPSyslogAppender.pas
View File

@ -2,7 +2,7 @@
//
// LoggerPro
//
// Copyright (c) 2010-2023 Daniele Teti
// Copyright (c) 2010-2024 Daniele Teti
//
// https://github.com/danieleteti/loggerpro
//

2
LoggerPro.Utils.pas
View File

@ -2,7 +2,7 @@
//
// LoggerPro
//
// Copyright (c) 2010-2023 Daniele Teti
// Copyright (c) 2010-2024 Daniele Teti
//
// https://github.com/danieleteti/loggerpro
//

2
LoggerPro.VCLListBoxAppender.pas
View File

@ -2,7 +2,7 @@
//
// LoggerPro
//
// Copyright (c) 2010-2023 Daniele Teti
// Copyright (c) 2010-2024 Daniele Teti
//
// https://github.com/danieleteti/loggerpro
//

2
LoggerPro.VCLListViewAppender.pas
View File

@ -2,7 +2,7 @@
//
// LoggerPro
//
// Copyright (c) 2010-2023 Daniele Teti
// Copyright (c) 2010-2024 Daniele Teti
//
// https://github.com/danieleteti/loggerpro
//

2
LoggerPro.VCLMemoAppender.pas
View File

@ -2,7 +2,7 @@
//
// LoggerPro
//
// Copyright (c) 2010-2023 Daniele Teti
// Copyright (c) 2010-2024 Daniele Teti
//
// https://github.com/danieleteti/loggerpro
//

2
LoggerPro.WindowsEventLogAppender.pas
View File

@ -2,7 +2,7 @@
//
// LoggerPro
//
// Copyright (c) 2010-2023 Daniele Teti
// Copyright (c) 2010-2024 Daniele Teti
//
// https://github.com/danieleteti/loggerpro
//

5
LoggerPro.pas
View File

@ -299,11 +299,9 @@ type
FEnabled: Boolean;
FLastErrorTimeStamp: TDateTime;
FOnLogRow: TOnAppenderLogRow;
//FLogFormat: string;
FLogItemRenderer: ILogItemRenderer;
FFormatSettings: TFormatSettings;
protected
// property LogFormat: string read FLogFormat;
property FormatSettings: TFormatSettings read FFormatSettings;
public
constructor Create(ALogItemRenderer: ILogItemRenderer = nil); virtual;
@ -403,6 +401,7 @@ function LogLayoutByPlaceHoldersToLogLayoutByIndexes(const LogLayoutByPlaceHolde
var
PlaceHolders, PlaceHolderWidthsAndPaddings: TArray<string>;
I: Integer;
lIdx: Integer;
begin
if LogLayoutByPlaceHolders.Contains('%s') or LogLayoutByPlaceHolders.Contains('%d') then
begin
@ -440,7 +439,7 @@ begin
if UseZeroBasedIncrementalIndexes then
begin
var lIdx := 0;
lIdx := 0;
for I := 0 to High(PlaceHolders) do
begin
if Result.Contains('{' + PlaceHolders[I] + '}') then

2
ThreadSafeQueueU.pas
View File

@ -2,7 +2,7 @@
//
// LoggerPro
//
// Copyright (c) 2010-2023 Daniele Teti
// Copyright (c) 2010-2024 Daniele Teti
//
// https://github.com/danieleteti/loggerpro
//

60
samples/140_DB_appender/ADOAppenderFormU.dfm Normal file
View File

@ -0,0 +1,60 @@
object MainForm: TMainForm
Left = 0
Top = 0
Caption = 'LoggerPro SAMPLE'
ClientHeight = 142
ClientWidth = 584
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
Visible = True
TextHeight = 13
object Button1: TButton
Left = 8
Top = 8
Width = 137
Height = 57
Caption = 'DEBUG'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 151
Top = 8
Width = 137
Height = 57
Caption = 'INFO'
TabOrder = 1
OnClick = Button2Click
end
object Button3: TButton
Left = 294
Top = 8
Width = 137
Height = 57
Caption = 'WARNING'
TabOrder = 2
OnClick = Button3Click
end
object Button4: TButton
Left = 437
Top = 8
Width = 137
Height = 57
Caption = 'ERROR'
TabOrder = 3
OnClick = Button4Click
end
object Button5: TButton
Left = 8
Top = 71
Width = 280
Height = 57
Caption = 'Multithread logging'
TabOrder = 4
OnClick = Button5Click
end
end

92
samples/140_DB_appender/ADOAppenderFormU.pas Normal file
View File

@ -0,0 +1,92 @@
unit ADOAppenderFormU;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils,
System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls,
LoggerPro,
Vcl.ExtCtrls;
type
TMainForm = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
uses
LoggerProConfig;
procedure TMainForm.Button1Click(Sender: TObject);
begin
Log.Debug('This is a debug message with TAG1', 'TAG1');
end;
procedure TMainForm.Button2Click(Sender: TObject);
begin
Log.Info('This is a info message with TAG1', 'TAG1');
end;
procedure TMainForm.Button3Click(Sender: TObject);
begin
Log.Warn('This is a warning message with TAG1', 'TAG1');
end;
procedure TMainForm.Button4Click(Sender: TObject);
begin
Log.Error('This is a error message with TAG1', 'TAG1');
end;
procedure TMainForm.Button5Click(Sender: TObject);
var
lThreadProc: TProc;
begin
lThreadProc := procedure
var
I: Integer;
lThreadID: string;
begin
lThreadID := IntToStr(TThread.Current.ThreadID);
for I := 1 to 100 do
begin
Log.Debug('log message %s ThreadID: %s', [TimeToStr(now), lThreadID], 'MULTITHREADING');
Log.Info('log message %s ThreadID: %s', [TimeToStr(now), lThreadID], 'MULTITHREADING');
Log.Warn('log message %s ThreadID: %s', [TimeToStr(now), lThreadID], 'MULTITHREADING');
Log.Error('log message %s ThreadID: %s', [TimeToStr(now), lThreadID], 'MULTITHREADING');
Log.Fatal('log message %s ThreadID: %s', [TimeToStr(now), lThreadID], 'MULTITHREADING');
end;
end;
TThread.CreateAnonymousThread(lThreadProc).Start;
TThread.CreateAnonymousThread(lThreadProc).Start;
TThread.CreateAnonymousThread(lThreadProc).Start;
TThread.CreateAnonymousThread(lThreadProc).Start;
end;
end.

80
samples/140_DB_appender/LoggerProConfig.pas Normal file
View File

@ -0,0 +1,80 @@
unit LoggerProConfig;
// instantiate and call the Logging appender that writes to the Logging database
interface
uses
LoggerPro;
///<summary>global function pointer tha returns a DB Logger instance</summary>
var
Log: function: ILogWriter;
implementation
uses
System.SysUtils,
System.Classes,
LoggerPro.DBAppender.ADO,
Data.DB, Data.Win.ADODB,
System.IOUtils,
Winapi.ActiveX, System.NetEncoding;
var
_Log: ILogWriter;
const
FailedDBWriteTag = 'FailedDBWrite';
function GetLogger: ILogWriter;
begin
if _Log = nil then
begin
_Log := BuildLogWriter([TLoggerProDBAppenderADO.Create(
// create an ADO DB Connection
function: TCustomConnection
begin
Result := TADOConnection.Create(nil);
Result.LoginPrompt := False;
// todo: set the connection string in here, typically read from env variables or config file
TADOConnection(Result).ConnectionString := '';
end,
// create a stored proc
function(Connection: TCustomConnection): TADOStoredProc
begin
Result := TADOStoredProc.Create(nil);
Result.ProcedureName := 'todo: set the stored proc name here';
Result.Connection := Connection as TADOConnection;
end,
// populate the stored proc
procedure(SP: TADOStoredProc; LogItem: TLogItem)
begin
SP.Parameters.ParamByName('@LogType').Value := Integer(LogItem.LogType);
SP.Parameters.ParamByName('@LogTag').Value := LogItem.LogTag;
SP.Parameters.ParamByName('@LogMessage').Value := LogItem.LogMessage;
SP.Parameters.ParamByName('@Timestamp').Value := LogItem.TimeStamp;
SP.Parameters.ParamByName('@TID').Value := LogItem.ThreadID;
end,
// error handler, just write to disk on the server for later analysis
procedure(const Sender: TObject; const LogItem: TLogItem; const DBError: Exception; var RetryCount: Integer)
begin
// write code in here to write out using system default logger to a local file
// Log.Error('Could not write Viewer Request: %s', [DBError.Message], FailedDBWriteTag);
// Log.Error('Data: %s', [LogItem.LogMessage], FailedDBWriteTag);
end)]);
end;
Result := _Log;
end;
initialization
Log := GetLogger;
finalization
_Log := nil;
end.

16
samples/140_DB_appender/dbGoAppenderSample.dpr Normal file
View File

@ -0,0 +1,16 @@
program dbGoAppenderSample;
uses
Vcl.Forms,
ADOAppenderFormU in 'ADOAppenderFormU.pas' {MainForm},
LoggerProConfig in 'LoggerProConfig.pas';
//LoggerPro.RESTAppender in '..\..\LoggerPro.RESTAppender.pas';
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

1096
samples/140_DB_appender/dbGoAppenderSample.dproj Normal file
View File

File diff suppressed because it is too large Load Diff

10
samples/140_DB_appender/readme.txt Normal file
View File

@ -0,0 +1,10 @@
You will need a SQL Server database with a stored procedure that can accept the log item as parameters
e.g.
@LogType int,
@LogTag nvarchar(25),
@LogMessage nvarchar(4096),
@Timestamp datetime,
@TID int
You will also need to configure the DB Connection string in the LoggerProConfig unit.

227
samples/150_DB_appender_firedac/FDConnectionConfigU.pas Normal file
View File

@ -0,0 +1,227 @@
unit FDConnectionConfigU;
interface
const
CON_DEF_NAME = 'LoggerProConnectionX';
procedure CreateFirebirdPrivateConnDef(AIsPooled: boolean);
procedure CreateInterbasePrivateConnDef(AIsPooled: boolean);
procedure CreateMySQLPrivateConnDef(AIsPooled: boolean);
procedure CreateMSSQLServerPrivateConnDef(AIsPooled: boolean);
procedure CreatePostgresqlPrivateConnDef(AIsPooled: boolean);
procedure CreateSqlitePrivateConnDef(AIsPooled: boolean);
implementation
uses
System.Classes,
System.IOUtils,
FireDAC.Comp.Client,
FireDAC.Moni.Base,
FireDAC.Moni.FlatFile,
FireDAC.Stan.Intf,
FireDAC.Phys.PG
;
var
gFlatFileMonitor: TFDMoniFlatFileClientLink = nil;
procedure CreateMySQLPrivateConnDef(AIsPooled: boolean);
var
LParams: TStringList;
begin
{
docker run --detach --env MARIADB_USER=example-user --env MARIADB_PASSWORD=my_cool_secret --env MARIADB_ROOT_PASSWORD=root -p 3306:3306 mariadb:latest
}
LParams := TStringList.Create;
try
LParams.Add('Database=activerecorddb');
LParams.Add('Protocol=TCPIP');
LParams.Add('Server=localhost');
LParams.Add('User_Name=root');
LParams.Add('Password=root');
LParams.Add('TinyIntFormat=Boolean'); { it's the default }
LParams.Add('CharacterSet=utf8mb4'); // not utf8!!
LParams.Add('MonitorBy=FlatFile');
if AIsPooled then
begin
LParams.Add('Pooled=True');
LParams.Add('POOL_MaximumItems=100');
end
else
begin
LParams.Add('Pooled=False');
end;
FDManager.AddConnectionDef(CON_DEF_NAME, 'MySQL', LParams);
finally
LParams.Free;
end;
end;
procedure CreateMSSQLServerPrivateConnDef(AIsPooled: boolean);
var
LParams: TStringList;
begin
{
docker run -e "ACCEPT_EULA=Y" -e "SA_PASSWORD=!SA_password!" -p 1433:1433 -d mcr.microsoft.com/mssql/server:2019-latest
}
// [ACTIVERECORDB_SQLSERVER]
// Database=activerecorddb
// OSAuthent=Yes
// Server=DANIELETETI\SQLEXPRESS
// DriverID=MSSQL
//
LParams := TStringList.Create;
try
LParams.Add('Database=activerecorddb');
LParams.Add('OSAuthent=Yes');
LParams.Add('Server=DANIELETETI\SQLEXPRESS');
if AIsPooled then
begin
LParams.Add('Pooled=True');
LParams.Add('POOL_MaximumItems=100');
end
else
begin
LParams.Add('Pooled=False');
end;
FDManager.AddConnectionDef(CON_DEF_NAME, 'MSSQL', LParams);
finally
LParams.Free;
end;
end;
procedure CreateFirebirdPrivateConnDef(AIsPooled: boolean);
var
LParams: TStringList;
begin
LParams := TStringList.Create;
try
LParams.Add('Database=' + TPath.GetFullPath(TPath.Combine('..\..',
'data\ACTIVERECORDDB.FDB')));
LParams.Add('Protocol=TCPIP');
LParams.Add('Server=localhost');
LParams.Add('User_Name=sysdba');
LParams.Add('Password=masterkey');
LParams.Add('CharacterSet=UTF8');
if AIsPooled then
begin
LParams.Add('Pooled=True');
LParams.Add('POOL_MaximumItems=100');
end
else
begin
LParams.Add('Pooled=False');
end;
FDManager.AddConnectionDef(CON_DEF_NAME, 'FB', LParams);
finally
LParams.Free;
end;
end;
procedure CreateInterbasePrivateConnDef(AIsPooled: boolean);
var
LParams: TStringList;
begin
LParams := TStringList.Create;
try
LParams.Add('Database=' + TPath.GetFullPath(TPath.Combine('..\..',
'data\ACTIVERECORDDB.IB')));
LParams.Add('Protocol=TCPIP');
LParams.Add('Server=localhost');
LParams.Add('User_Name=sysdba');
LParams.Add('Password=masterkey');
LParams.Add('CharacterSet=UTF8');
if AIsPooled then
begin
LParams.Add('Pooled=True');
LParams.Add('POOL_MaximumItems=100');
end
else
begin
LParams.Add('Pooled=False');
end;
FDManager.AddConnectionDef(CON_DEF_NAME, 'IB', LParams);
finally
LParams.Free;
end;
end;
procedure CreatePostgresqlPrivateConnDef(AIsPooled: boolean);
var
LParams: TStringList;
begin
LParams := TStringList.Create;
try
LParams.Add('Database=activerecorddb');
LParams.Add('Protocol=TCPIP');
LParams.Add('Server=localhost');
LParams.Add('User_Name=postgres');
LParams.Add('Password=postgres');
//LParams.Add('MonitorBy=FlatFile');
// https://quality.embarcadero.com/browse/RSP-19755?jql=text%20~%20%22firedac%20guid%22
LParams.Add('GUIDEndian=Big');
if AIsPooled then
begin
LParams.Add('Pooled=True');
LParams.Add('POOL_MaximumItems=100');
end
else
begin
LParams.Add('Pooled=False');
end;
FDManager.AddConnectionDef(CON_DEF_NAME, 'PG', LParams);
finally
LParams.Free;
end;
end;
procedure CreateSqlitePrivateConnDef(AIsPooled: boolean);
var
LParams: TStringList;
lFName: string;
begin
LParams := TStringList.Create;
try
lFName := TPath.Combine(TPath.GetDirectoryName(ParamStr(0)),
'..\..\data\activerecorddb.db');
LParams.Add('Database=' + lFName);
LParams.Add('StringFormat=Unicode');
if AIsPooled then
begin
LParams.Add('Pooled=True');
LParams.Add('POOL_MaximumItems=100');
end
else
begin
LParams.Add('Pooled=False');
end;
FDManager.AddConnectionDef(CON_DEF_NAME, 'SQLite', LParams);
finally
LParams.Free;
end;
end;
initialization
gFlatFileMonitor := TFDMoniFlatFileClientLink.Create(nil);
gFlatFileMonitor.FileColumns := [tiRefNo, tiTime, tiThreadID, tiClassName, tiObjID, tiMsgText];
gFlatFileMonitor.EventKinds := [
ekVendor, ekConnConnect, ekLiveCycle, ekError, ekConnTransact,
ekCmdPrepare, ekCmdExecute, ekCmdDataIn, ekCmdDataOut];
gFlatFileMonitor.ShowTraces := False;
gFlatFileMonitor.FileAppend := False;
gFlatFileMonitor.FileName := TPath.ChangeExtension(ParamStr(0), '.trace.log');
gFlatFileMonitor.Tracing := True;
finalization
gFlatFileMonitor.Free;
end.

60
samples/150_DB_appender_firedac/FireDACAppenderFormU.dfm Normal file
View File

@ -0,0 +1,60 @@
object MainForm: TMainForm
Left = 0
Top = 0
Caption = 'LoggerPro SAMPLE'
ClientHeight = 142
ClientWidth = 584
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
Visible = True
TextHeight = 13
object Button1: TButton
Left = 8
Top = 8
Width = 137
Height = 57
Caption = 'DEBUG'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 151
Top = 8
Width = 137
Height = 57
Caption = 'INFO'
TabOrder = 1
OnClick = Button2Click
end
object Button3: TButton
Left = 294
Top = 8
Width = 137
Height = 57
Caption = 'WARNING'
TabOrder = 2
OnClick = Button3Click
end
object Button4: TButton
Left = 437
Top = 8
Width = 137
Height = 57
Caption = 'ERROR'
TabOrder = 3
OnClick = Button4Click
end
object Button5: TButton
Left = 8
Top = 71
Width = 280
Height = 57
Caption = 'Multithread logging'
TabOrder = 4
OnClick = Button5Click
end
end

92
samples/150_DB_appender_firedac/FireDACAppenderFormU.pas Normal file
View File

@ -0,0 +1,92 @@
unit FireDACAppenderFormU;
interface
uses
Winapi.Windows,
Winapi.Messages,
System.SysUtils,
System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls,
LoggerPro,
Vcl.ExtCtrls;
type
TMainForm = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
uses
LoggerProConfig;
procedure TMainForm.Button1Click(Sender: TObject);
begin
Log.Debug('This is a debug message with TAG1', 'TAG1');
end;
procedure TMainForm.Button2Click(Sender: TObject);
begin
Log.Info('This is a info message with TAG1', 'TAG1');
end;
procedure TMainForm.Button3Click(Sender: TObject);
begin
Log.Warn('This is a warning message with TAG1', 'TAG1');
end;
procedure TMainForm.Button4Click(Sender: TObject);
begin
Log.Error('This is a error message with TAG1', 'TAG1');
end;
procedure TMainForm.Button5Click(Sender: TObject);
var
lThreadProc: TProc;
begin
lThreadProc := procedure
var
I: Integer;
lThreadID: string;
begin
lThreadID := IntToStr(TThread.Current.ThreadID);
for I := 1 to 100 do
begin
Log.Debug('log message %s ThreadID: %s', [TimeToStr(now), lThreadID], 'MULTITHREADING');
Log.Info('log message %s ThreadID: %s', [TimeToStr(now), lThreadID], 'MULTITHREADING');
Log.Warn('log message %s ThreadID: %s', [TimeToStr(now), lThreadID], 'MULTITHREADING');
Log.Error('log message %s ThreadID: %s', [TimeToStr(now), lThreadID], 'MULTITHREADING');
Log.Fatal('log message %s ThreadID: %s', [TimeToStr(now), lThreadID], 'MULTITHREADING');
end;
end;
TThread.CreateAnonymousThread(lThreadProc).Start;
TThread.CreateAnonymousThread(lThreadProc).Start;
TThread.CreateAnonymousThread(lThreadProc).Start;
TThread.CreateAnonymousThread(lThreadProc).Start;
end;
end.

1
samples/150_DB_appender_firedac/FireDACAppenderSample.delphilsp.json Normal file
View File

File diff suppressed because one or more lines are too long

19
samples/150_DB_appender_firedac/FireDACAppenderSample.dpr Normal file
View File

@ -0,0 +1,19 @@
program FireDACAppenderSample;
uses
Vcl.Forms,
FireDACAppenderFormU in 'FireDACAppenderFormU.pas' {MainForm},
LoggerProConfig in 'LoggerProConfig.pas',
FDConnectionConfigU in 'FDConnectionConfigU.pas';
//LoggerPro.RESTAppender in '..\..\LoggerPro.RESTAppender.pas';
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := True;
CreatePostgresqlPrivateConnDef(False);
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

1104
samples/150_DB_appender_firedac/FireDACAppenderSample.dproj Normal file
View File

File diff suppressed because it is too large Load Diff

112
samples/150_DB_appender_firedac/LoggerProConfig.pas Normal file
View File

@ -0,0 +1,112 @@
unit LoggerProConfig;
// instantiate and call the Logging appender that writes to the Logging database
interface
uses
LoggerPro;
///<summary>global function pointer tha returns a DB Logger instance</summary>
var
Log: function: ILogWriter;
implementation
uses
System.SysUtils,
System.Classes,
LoggerPro.DBAppender.FireDAC,
LoggerPro.FileAppender,
Data.DB,
System.IOUtils,
System.NetEncoding,
FireDAC.Stan.Intf,
FireDAC.Stan.Option,
FireDAC.Stan.Error,
FireDAC.UI.Intf,
FireDAC.Phys.Intf,
FireDAC.Stan.Def,
FireDAC.Stan.Pool,
FireDAC.Stan.Async,
FireDAC.Stan.Param,
FireDAC.Phys,
FireDAC.VCLUI.Wait,
FireDAC.Comp.Client,
FDConnectionConfigU,
LoggerPro.Renderers;
var
_Log: ILogWriter;
_FallbackLog: ILogWriter;
const
FailedDBWriteTag = 'FailedDBWrite';
function GetFallBackLogger: ILogWriter;
begin
if _FallbackLog = nil then
begin
_FallbackLog := BuildLogWriter([
TLoggerProSimpleFileAppender.Create(10, 2048, 'logs')
]);
end;
Result := _FallbackLog;
end;
function GetLogger: ILogWriter;
begin
if _Log = nil then
begin
GetFallBackLogger.Info('Initializing db appender', FailedDBWriteTag);
_Log := BuildLogWriter([TLoggerProDBAppenderFireDAC.Create(
// create an ADO DB Connection
function: TCustomConnection
begin
Result := TFDConnection.Create(nil);
Result.LoginPrompt := False;
// todo: set the connection string in here, typically read from env variables or config file
TFDConnection(Result).ConnectionDefName := CON_DEF_NAME;
end,
// create a stored proc
function(Connection: TCustomConnection): TFDStoredProc
begin
Result := TFDStoredProc.Create(nil);
Result.StoredProcName := 'sp_loggerpro_writer';
Result.Connection := Connection as TFDConnection;
end,
// populate the stored proc
procedure(SP: TFDStoredProc; LogItem: TLogItem)
begin
SP.ParamByName('p_log_type').Value := Integer(LogItem.LogType);
SP.ParamByName('p_log_tag').Value := LogItem.LogTag;
SP.ParamByName('p_log_message').Value := LogItem.LogMessage;
SP.ParamByName('p_log_timestamp').Value := LogItem.TimeStamp;
SP.ParamByName('p_log_thread_id').Value := LogItem.ThreadID;
end,
// error handler, just write to disk on the server for later analysis
procedure(const Sender: TObject; const LogItem: TLogItem; const DBError: Exception; var RetryCount: Integer)
var
lIntf: ILogItemRenderer;
begin
lIntf := GetDefaultLogItemRenderer();
GetFallBackLogger.Error('DBAppender Is Failing (%d): %s %s', [RetryCount, DBError.ClassName, DBError.Message], FailedDBWriteTag);
GetFallBackLogger.Error(lIntf.RenderLogItem(LogItem), FailedDBWriteTag);
end)]);
end;
Result := _Log;
end;
initialization
Log := GetLogger;
finalization
_Log := nil;
_FallbackLog := nil;
end.

27
samples/150_DB_appender_firedac/postgresql_ddl.sql Normal file
View File

@ -0,0 +1,27 @@
drop procedure if exists sp_loggerpro_writer;
drop table if exists loggerpro_logs;
create table loggerpro_logs (
id int generated by default as identity,
log_type int,
log_tag varchar,
log_message varchar,
log_timestamp timestamp,
log_thread_id integer
);
create or replace procedure sp_loggerpro_writer(
p_log_type int,
p_log_tag varchar,
p_log_message varchar,
p_log_timestamp timestamp,
p_log_thread_id integer
)
language plpgsql
as $$
begin
INSERT INTO
public.loggerpro_logs(log_type, log_tag, log_message, log_timestamp, log_thread_id)
values (p_log_type, p_log_tag, p_log_message, p_log_timestamp, p_log_thread_id);
end;
$$;

5
samples/50_custom_appender/LoggerProConfig.pas
View File

@ -41,11 +41,10 @@ end;
procedure TMyCustomAppender.WriteLog(const aLogItem: TLogItem);
begin
// uncomment this to see what happend if an appender raise an exception
// uncomment this to see what happens if an appender raise an exception
// raise Exception.Create('Kill LoggerPro');
// uncomment this to see what happend if an appender is slow
// uncomment this to see what happens if an appender is slow
Sleep(2000);
WriteLn('[THE BAD APPENDER] ' + aLogItem.LogMessage);
end;