Implemented ExceptionS method

Test/source/MainFrm.dfm

@@ -32,6 +32,10 @@ object MainForm: TMainForm
     TabOrder = 0
     object tsEvent: TTabSheet
       Caption = 'Event'
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       object mmoEvent: TMemo
         AlignWithMargins = True
         Left = 8
@@ -68,6 +72,10 @@ object MainForm: TMainForm
     end
     object tsFile: TTabSheet
       Caption = 'File'
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       DesignSize = (
         623
         299)
@@ -160,6 +168,10 @@ object MainForm: TMainForm
     end
     object tsRollingFile: TTabSheet
       Caption = 'Rolling File'
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       DesignSize = (
         623
         299)
@@ -267,6 +279,10 @@ object MainForm: TMainForm
     end
     object tsNamedPipe: TTabSheet
       Caption = 'Named Pipe'
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       DesignSize = (
         623
         299)
@@ -410,11 +426,15 @@ object MainForm: TMainForm
     Margins.Top = 8
     Margins.Right = 8
     Margins.Bottom = 0
-    ActivePage = tsStructured
+    ActivePage = tsText
     Align = alTop
     TabOrder = 2
     object tsText: TTabSheet
       Caption = 'Text'
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       DesignSize = (
         623
         76)
@@ -484,6 +504,10 @@ object MainForm: TMainForm
     object tsException: TTabSheet
       Caption = 'Exception'
       ImageIndex = 1
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       DesignSize = (
         623
         76)
@@ -517,6 +541,10 @@ object MainForm: TMainForm
     object tsBinary: TTabSheet
       Caption = 'Binary'
       ImageIndex = 2
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       object btnBinaryRawByteString: TButton
         Left = 12
         Top = 15
@@ -539,6 +567,10 @@ object MainForm: TMainForm
     object tsTimer: TTabSheet
       Caption = 'Timer'
       ImageIndex = 3
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       object lblTimer: TLabel
         Left = 8
         Top = 12
@@ -586,6 +618,10 @@ object MainForm: TMainForm
     object tsStructured: TTabSheet
       Caption = 'Structured'
       ImageIndex = 4
+      ExplicitLeft = 0
+      ExplicitTop = 0
+      ExplicitWidth = 0
+      ExplicitHeight = 0
       object btnValueTypes: TButton
         Left = 12
         Top = 15
@@ -595,6 +631,15 @@ object MainForm: TMainForm
         TabOrder = 0
         OnClick = btnValueTypesClick
       end
+      object btnStructuredException: TButton
+        Left = 139
+        Top = 15
+        Width = 121
+        Height = 21
+        Caption = 'Exception test'
+        TabOrder = 1
+        OnClick = btnStructuredExceptionClick
+      end
     end
   end
   object pnlDispatch: TPanel
@@ -661,7 +706,7 @@ object MainForm: TMainForm
     Left = 552
     Top = 176
     Bitmap = {
-      494C01010200140068000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
+      494C01010200140070000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
       0000000000003600000028000000300000000C00000001002000000000000009
       0000000000000000000000000000000000000000000000000000000000000000
       0000000000000000000000000000000000000000000000000000000000000000

Test/source/MainFrm.pas

@@ -87,6 +87,7 @@ type
     pnlRollingFileTextFormatter: TPanel;
     rbRollingFileTextFormatterDefault: TRadioButton;
     rbRollingFileTextFormatterJson: TRadioButton;
+    btnStructuredException: TButton;
     
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
@@ -114,6 +115,7 @@ type
     procedure btnRollingFileStartClick(Sender: TObject);
     procedure btnRollingFileStopClick(Sender: TObject);
     procedure btnValueTypesClick(Sender: TObject);
+    procedure btnStructuredExceptionClick(Sender: TObject);
   private
     FLog: IX2Log;
     FEventObserver: IX2LogObserver;
@@ -502,4 +504,15 @@ begin
      'Integer', 89740987342]);
 end;
 
+
+procedure TMainForm.btnStructuredExceptionClick(Sender: TObject);
+begin
+  try
+    raise Exception.Create('Stuff''s broken!');
+  except
+    on E:Exception do
+      FLog.ExceptionS(e, 'I totally expected that.', ['HasExtraInfo', False]);
+  end;
+end;
+
 end.

X2Log.Decorator.pas

@@ -53,6 +53,7 @@ type
 
     procedure Exception(AException: Exception; const AMessage: string = '');
     procedure ExceptionEx(AException: Exception; const AMessage: string = ''; const ACategory: string = '');
+    procedure ExceptionS(AException: Exception; const AMessage: string; ANamedParams: array of const);
   end;
 
 
@@ -212,6 +213,13 @@ begin
 end;
 
 
+procedure TX2LogCategoryDecorator.ExceptionS(AException: Exception; const AMessage: string; ANamedParams: array of const);
+begin
+  if Assigned(DecoratedLog) then
+    DecoratedLog.ExceptionS(AException, AMessage, ANamedParams);
+end;
+
+
 function TX2LogCategoryDecorator.GetCategory(const ACategory: string): string;
 begin
   Result := CategoryName;

X2Log.Details.Default.pas

@@ -62,8 +62,17 @@ type
   TX2LogValueDictionary = TObjectDictionary<string, TX2LogDictionaryValue>;
 
 
+  IX2LogDetailsDictionaryWriter = interface(IX2LogDetailsDictionary)
+    procedure SetStringValue(const Key: string; const AValue: string);
+    procedure SetBooleanValue(const Key: string; const AValue: Boolean);
+    procedure SetIntValue(const Key: string; const AValue: Int64);
+    procedure SetFloatValue(const Key: string; const AValue: Extended);
+    procedure SetDateTimeValue(const Key: string; const AValue: TDateTime);
+  end;
+
+
   TX2LogDictionaryDetails = class(TInterfacedObject, IX2LogDetails, IX2LogDetailsDictionary,
-                                                     IX2LogDetailsDictionaryAccess)
+                                                     IX2LogDetailsDictionaryAccess, IX2LogDetailsDictionaryWriter)
   private
     FValues: TX2LogValueDictionary;
   protected
@@ -90,6 +99,13 @@ type
     function GetIntValue(const Key: string): Int64;
     function GetFloatValue(const Key: string): Extended;
     function GetDateTimeValue(const Key: string): TDateTime;
+
+    { IX2LogDetailsDictionaryWriter }
+    procedure SetStringValue(const Key: string; const AValue: string);
+    procedure SetBooleanValue(const Key: string; const AValue: Boolean);
+    procedure SetIntValue(const Key: string; const AValue: Int64);
+    procedure SetFloatValue(const Key: string; const AValue: Extended);
+    procedure SetDateTimeValue(const Key: string; const AValue: TDateTime);
   end;
 
 
@@ -480,6 +496,36 @@ begin
 end;
 
 
+procedure TX2LogDictionaryDetails.SetBooleanValue(const Key: string; const AValue: Boolean);
+begin
+  FValues.Add(Key, TX2LogDictionaryBooleanValue.Create(AValue));
+end;
+
+
+procedure TX2LogDictionaryDetails.SetDateTimeValue(const Key: string; const AValue: TDateTime);
+begin
+  FValues.Add(Key, TX2LogDictionaryDateTimeValue.Create(AValue));
+end;
+
+
+procedure TX2LogDictionaryDetails.SetFloatValue(const Key: string; const AValue: Extended);
+begin
+  FValues.Add(Key, TX2LogDictionaryFloatValue.Create(AValue));
+end;
+
+
+procedure TX2LogDictionaryDetails.SetIntValue(const Key: string; const AValue: Int64);
+begin
+  FValues.Add(Key, TX2LogDictionaryIntValue.Create(AValue));
+end;
+
+
+procedure TX2LogDictionaryDetails.SetStringValue(const Key, AValue: string);
+begin
+  FValues.Add(Key, TX2LogDictionaryStringValue.Create(AValue));
+end;
+
+
 { TX2LogBinaryDetails }
 constructor TX2LogBinaryDetails.Create;
 begin

X2Log.Exception.Default.pas

@@ -11,7 +11,7 @@ type
   TX2LogDefaultExceptionStrategy = class(TInterfacedObject, IX2LogExceptionStrategy)
   public
     { IX2LogExceptionStrategy }
-    procedure Execute(AException: Exception; var AMessage: string; var ADetails: IX2LogDetails); virtual;
+    procedure Execute(AException: Exception; out AMessage: string; AAddDetails: TX2LogExceptionDetailsProc); virtual;
   end;
 
 
@@ -19,12 +19,9 @@ implementation
 
 
 { TX2LogDefaultExceptionStrategy }
-procedure TX2LogDefaultExceptionStrategy.Execute(AException: Exception; var AMessage: string; var ADetails: IX2LogDetails);
+procedure TX2LogDefaultExceptionStrategy.Execute(AException: Exception; out AMessage: string; AAddDetails: TX2LogExceptionDetailsProc);
 begin
-  if Length(AMessage) > 0 then
+  AMessage := AException.Message;
-    AMessage := AMessage + ': ';
-
-  AMessage := AMessage + AException.Message;
 end;
 
 end.

X2Log.Exception.madExceptHandler.pas

@@ -12,7 +12,7 @@ type
   TX2LogmadExceptExceptionStrategy = class(TX2LogDefaultExceptionStrategy)
   public
     { IX2LogExceptionStrategy }
-    procedure Execute(AException: Exception; var AMessage: string; var ADetails: IX2LogDetails); override;
+    procedure Execute(AException: Exception; out AMessage: string; AAddDetails: TX2LogExceptionDetailsProc); override;
   end;
 
 
@@ -24,11 +24,16 @@ uses
 
 
 { TX2LogmadExceptExceptionStrategy }
-procedure TX2LogmadExceptExceptionStrategy.Execute(AException: Exception; var AMessage: string; var ADetails: IX2LogDetails);
+procedure TX2LogmadExceptExceptionStrategy.Execute(AException: Exception; out AMessage: string; AAddDetails: TX2LogExceptionDetailsProc);
-begin
+var
-  inherited Execute(AException, AMessage, ADetails);
+  bugReport: string;
 
-  ADetails := TX2LogStringDetails.CreateIfNotEmpty(madExcept.CreateBugReport(etNormal, AException));
+begin
+  inherited Execute(AException, AMessage, AAddDetails);
+
+  bugReport := madExcept.CreateBugReport(etNormal, AException);
+  if Length(bugReport) > 0 then
+    AAddDetails('StackTrace', bugReport);
 end;
 
 end.

X2Log.Intf.pas

@@ -58,9 +58,11 @@ type
   end;
 
 
+  TX2LogExceptionDetailsProc = reference to procedure(const AKey, AValue: string);
+
   IX2LogExceptionStrategy = interface
     ['{C0B7950E-BE0A-4A21-A7C5-F8322FD4E205}']
-    procedure Execute(AException: Exception; var AMessage: string; var ADetails: IX2LogDetails);
+    procedure Execute(AException: Exception; out AMessage: string; AAddDetails: TX2LogExceptionDetailsProc);
   end;
 
 
@@ -95,6 +97,7 @@ type
 
     procedure Exception(AException: Exception; const AMessage: string = '');
     procedure ExceptionEx(AException: Exception; const AMessage: string = ''; const ACategory: string = '');
+    procedure ExceptionS(AException: Exception; const AMessage: string; ANamedParams: array of const);
   end;
 
 

X2Log.pas

@@ -42,6 +42,7 @@ type
 
     procedure Exception(AException: Exception; const AMessage: string = '');
     procedure ExceptionEx(AException: Exception; const AMessage: string = ''; const ACategory: string = '');
+    procedure ExceptionS(AException: Exception; const AMessage: string; ANamedParams: array of const);
   end;
 
 
@@ -158,14 +159,67 @@ end;
 procedure TX2Log.ExceptionEx(AException: Exception; const AMessage, ACategory: string);
 var
   msg: string;
+  exceptionMsg: string;
+  detailsText: TStringBuilder;
   details: IX2LogDetails;
 
 begin
   msg := AMessage;
   details := nil;
 
-  ExceptionStrategy.Execute(AException, msg, details);
+  detailsText := TStringBuilder.Create;
+  try
+    ExceptionStrategy.Execute(AException, exceptionMsg,
+      procedure(const AKey, AValue: string)
+      begin
+        detailsText.Append(AKey).Append(': ').Append(AValue).AppendLine;
+      end);
+
+    if Length(exceptionMsg) > 0 then
+    begin
+      if Length(msg) > 0 then
+        msg := msg + ': ';
+
+      msg := msg + exceptionMsg;
+    end;
+
+    details := TX2LogStringDetails.CreateIfNotEmpty(detailsText.ToString);
+  finally
+    FreeAndNil(detailsText);
+  end;
+
   Log(TX2LogLevel.Error, msg, ACategory, details);
 end;
 
+
+procedure TX2Log.ExceptionS(AException: Exception; const AMessage: string; ANamedParams: array of const);
+var
+  details: IX2LogDetailsDictionaryWriter;
+  exceptionMsg: string;
+
+begin
+  details := TX2LogDictionaryDetails.CreateIfNotEmpty(ANamedParams);
+
+  ExceptionStrategy.Execute(AException, exceptionMsg,
+    procedure(const AKey, AValue: string)
+    begin
+      if not Assigned(details) then
+        details := TX2LogDictionaryDetails.Create([]);
+
+      details.SetStringValue(AKey, AValue);
+    end);
+
+
+  if Length(exceptionMsg) > 0 then
+  begin
+    if not Assigned(details) then
+      details := TX2LogDictionaryDetails.Create([]);
+
+    details.SetStringValue('Message', exceptionMsg);
+  end;
+
+
+  Log(TX2LogLevel.Error, Now, AMessage, LogCategoryDefault, details);
+end;
+
 end.