Merge pull request #1 from danieleteti/v2.0

Merge Changes from head repository

LoggerPro.DBAppender.FireDAC.pas

@@ -9,6 +9,7 @@ interface
   LoggerPro, System.SysUtils, Data.DB,
   LoggerPro.DBAppender,
   FireDAC.Stan.Error,
+  FireDAC.DApt,
   FireDAC.Phys,
   FireDAC.Stan.Param,
   FireDAC.Comp.Client;
@@ -23,9 +24,6 @@   TLoggerProDBAppenderFireDAC = class(TLoggerProDBAppender<TFDStoredProc>)
 
 implementation
 
-uses
-  System.IOUtils, JsonDataObjects, Winapi.ActiveX;
-
 { TLoggerProDBAppenderFireDAC }
 
 procedure TLoggerProDBAppenderFireDAC.ExecuteDataObject(DataObj: TFDStoredProc);

LoggerPro.DBAppender.pas

@@ -23,9 +23,8 @@ interface
   ///<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)
-  private
-  protected const
-    MAX_RETRY_COUNT = 5;
+  protected
+    const MAX_RETRY_COUNT = 5;
   protected
     FOnDBWriteError: TOnDBWriteError;
     FGetDBConnection: TGetDBConnection;
@@ -111,21 +110,17 @@ procedure TLoggerProDBAppender<T>.TryToRestart(var Restarted: Boolean);
 
 procedure TLoggerProDBAppender<T>.WriteLog(const ALogItem: TLogItem);
 var
-  NeedsParamRefresh: Boolean;
   RetryCount: Integer;
 begin
   RetryCount := 0;
-
   repeat
     try
       if FDBObject = nil then
       begin
+        FDBConnection.Connected := True;  //force an exception if needed
         FDBObject := FGetStoredProc(FDBConnection);
-        NeedsParamRefresh := True;
+        RefreshParams(FDBObject); //this may not raise unhandled exception even in case of disconnection
       end;
-      if NeedsParamRefresh then
-        RefreshParams(FDBObject);
-
       FSetParams(FDBObject, ALogItem);
       ExecuteDataObject(FDBObject);
       Break;

LoggerPro.pas

@@ -299,11 +299,9 @@   TLoggerProAppenderBase = class abstract(TInterfacedObject, ILogAppender)
     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;

samples/150_DB_appender_firedac/FDConnectionConfigU.pas

@@ -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.

samples/150_DB_appender_firedac/FireDACAppenderFormU.dfm

@@ -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