Fixed: FS#4 - Binary details are lost with the Named Pipe observer

Fixed: FS#5 - Reconnecting can cause pipe to be busy
Fixed: FS#6 - Process hangs when closing after named pipe client has disconnected
Fixed: themed drawing of toolbar in MonitorForm
Fixed: various memory leaks
Changed: NamedPipeClient test application uses MonitorForm observer to display log

NamedPipeClient/X2LogNamedPipeClient.dpr

@@ -1,17 +1,30 @@
 program X2LogNamedPipeClient;
 
 uses
+//  FastMM4,
   Vcl.Forms,
-  MainFrm in 'source\MainFrm.pas' {MainForm};
+  X2Log.Intf,
+  X2Log.Client.NamedPipe,
+  X2Log.Observer.MonitorForm;
 
 {$R *.res}
 
 var
-  MainForm: TMainForm;
+  client: IX2LogObservable;
+  observerForm: TX2LogObserverMonitorForm;
 
 begin
+  ReportMemoryLeaksOnShutdown := True;
+
   Application.Initialize;
   Application.MainFormOnTaskbar := True;
-  Application.CreateForm(TMainForm, MainForm);
+  Application.Title := 'X²Log Named Pipe Client';
-  Application.Run;
+
+  client := TX2LogNamedPipeClient.Create('X2LogTest');
+  try
+    observerForm := TX2LogObserverMonitorForm.Instance(client);
+    observerForm.ShowModal;
+  finally
+    client := nil;
+  end;
 end.

NamedPipeClient/X2LogNamedPipeClient.dproj

@@ -84,10 +84,6 @@
 			<DelphiCompile Include="$(MainSource)">
 				<MainSource>MainSource</MainSource>
 			</DelphiCompile>
-			<DCCReference Include="source\MainFrm.pas">
-				<Form>MainForm</Form>
-				<FormType>dfm</FormType>
-			</DCCReference>
 			<BuildConfiguration Include="Release">
 				<Key>Cfg_2</Key>
 				<CfgParent>Base</CfgParent>

NamedPipeClient/source/MainFrm.dfm

@@ -1,27 +0,0 @@
-object MainForm: TMainForm
-  Left = 0
-  Top = 0
-  Caption = 'X'#178'Log Named Pipe Client'
-  ClientHeight = 443
-  ClientWidth = 552
-  Color = clBtnFace
-  Font.Charset = DEFAULT_CHARSET
-  Font.Color = clWindowText
-  Font.Height = -11
-  Font.Name = 'Tahoma'
-  Font.Style = []
-  OldCreateOrder = False
-  OnCreate = FormCreate
-  PixelsPerInch = 96
-  TextHeight = 13
-  object mmoLog: TMemo
-    Left = 0
-    Top = 0
-    Width = 552
-    Height = 443
-    Align = alClient
-    ReadOnly = True
-    ScrollBars = ssVertical
-    TabOrder = 0
-  end
-end

NamedPipeClient/source/MainFrm.pas

@@ -1,52 +0,0 @@
-unit MainFrm;
-
-interface
-uses
-  System.Classes,
-  Vcl.Controls,
-  Vcl.Forms,
-  Vcl.StdCtrls,
-
-  X2Log.Intf;
-
-
-type
-  TMainForm = class(TForm)
-    mmoLog: TMemo;
-
-    procedure FormCreate(Sender: TObject);
-  private
-    FClient: IX2LogObservable;
-    FObserver: IX2LogObserver;
-  protected
-    procedure DoLog(Sender: TObject; Level: TX2LogLevel; const Msg, Details: string);
-  end;
-
-
-implementation
-uses
-  System.SysUtils,
-
-  X2Log.Constants,
-  X2Log.Client.NamedPipe,
-  X2Log.Observer.Event;
-
-
-{$R *.dfm}
-
-
-{ TMainForm }
-procedure TMainForm.FormCreate(Sender: TObject);
-begin
-  FClient := TX2LogNamedPipeClient.Create('X2LogTest');
-  FObserver := TX2LogEventObserver.Create(DoLog);
-  FClient.Attach(FObserver);
-end;
-
-
-procedure TMainForm.DoLog(Sender: TObject; Level: TX2LogLevel; const Msg, Details: string);
-begin
-  mmoLog.Lines.Add(DateTimeToStr(Now) + ' ' + GetLogLevelText(Level) + ': ' + Msg + ' (' + Details + ')');
-end;
-
-end.

Test/X2LogTest.dpr

@@ -1,6 +1,7 @@
 program X2LogTest;
 
 uses
+//  FastMM4,
   Forms,
   MainFrm in 'source\MainFrm.pas' {MainForm},
   X2Log.Intf in '..\X2Log.Intf.pas',
@@ -17,7 +18,8 @@ uses
   X2Log.Global in '..\X2Log.Global.pas',
   X2Log.Client.NamedPipe in '..\X2Log.Client.NamedPipe.pas',
   X2Log.Client.Base in '..\X2Log.Client.Base.pas',
-  X2Log.Details.Default in '..\X2Log.Details.Default.pas';
+  X2Log.Details.Default in '..\X2Log.Details.Default.pas',
+  X2Log.Details.Registry in '..\X2Log.Details.Registry.pas';
 
 {$R *.res}
 

Test/X2LogTest.dproj

@@ -186,12 +186,12 @@
 			<DCCReference Include="..\X2Log.Observer.CustomThreaded.pas"/>
 			<DCCReference Include="..\X2Log.Observer.MonitorForm.pas">
 				<Form>X2LogObserverMonitorForm</Form>
-				<FormType>dfm</FormType>
 			</DCCReference>
 			<DCCReference Include="..\X2Log.Global.pas"/>
 			<DCCReference Include="..\X2Log.Client.NamedPipe.pas"/>
 			<DCCReference Include="..\X2Log.Client.Base.pas"/>
 			<DCCReference Include="..\X2Log.Details.Default.pas"/>
+			<DCCReference Include="..\X2Log.Details.Registry.pas"/>
 			<BuildConfiguration Include="Debug">
 				<Key>Cfg_2</Key>
 				<CfgParent>Base</CfgParent>

Test/source/MainFrm.dfm

@@ -349,7 +349,7 @@ object MainForm: TMainForm
       Shape = bsTopLine
     end
   end
-  object Panel1: TPanel
+  object pnlObservers: TPanel
     AlignWithMargins = True
     Left = 8
     Top = 144
@@ -370,7 +370,7 @@ object MainForm: TMainForm
     Font.Style = [fsBold]
     ParentFont = False
     TabOrder = 4
-    object Bevel1: TBevel
+    object bvlObservers: TBevel
       Left = 80
       Top = 12
       Width = 513
@@ -384,7 +384,7 @@ object MainForm: TMainForm
     Left = 552
     Top = 176
     Bitmap = {
-      494C01010200140034000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
+      494C01010200140038000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
       0000000000003600000028000000300000000C00000001002000000000000009
       0000000000000000000000000000000000000000000000000000000000000000
       0000000000000000000000000000000000000000000000000000000000000000

Test/source/MainFrm.pas

@@ -52,8 +52,8 @@ type
     tsBinary: TTabSheet;
     pnlDispatch: TPanel;
     bvlDispatch: TBevel;
-    Panel1: TPanel;
+    pnlObservers: TPanel;
-    Bevel1: TBevel;
+    bvlObservers: TBevel;
     
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);

X2Log.Client.NamedPipe.pas

@@ -17,6 +17,7 @@ type
     property WorkerThread: TThread read FWorkerThread;
   public
     constructor Create(const APipeName: string);
+    destructor Destroy; override;
   end;
 
 
@@ -24,18 +25,21 @@ implementation
 uses
   System.SyncObjs,
   System.SysUtils,
+  System.Types,
   Winapi.Windows,
 
-  X2Log.Details.Default;
+  X2Log.Details.Default,
+  X2Log.Details.Registry;
 
 
 type
   TX2LogNamedPipeClientWorkerThread = class(TThread)
   private
-    FLog: IX2LogBase;
+    FClient: TX2LogNamedPipeClient;
     FPipeName: string;
 
     FTerminateEvent: TEvent;
+    FReadEvent: TEvent;
     FPipeHandle: THandle;
     FOverlappedRead: TOverlapped;
     FReadBuffer: array[0..4095] of Byte;
@@ -51,14 +55,16 @@ type
     procedure ReadMessage;
     procedure HandleMessage;
 
-    property Log: IX2LogBase read FLog;
+    property Client: TX2LogNamedPipeClient read FClient;
     property PipeName: string read FPipeName;
 
+    property ReadEvent: TEvent read FReadEvent;
     property TerminateEvent: TEvent read FTerminateEvent;
     property PipeHandle: THandle read FPipeHandle;
     property MessageData: TMemoryStream read FMessageData;
   public
-    constructor Create(ALog: IX2LogBase; const APipeName: string);
+    constructor Create(AClient: TX2LogNamedPipeClient; const APipeName: string);
+    destructor Destroy; override;
   end;
 
 
@@ -80,19 +86,38 @@ begin
 end;
 
 
+destructor TX2LogNamedPipeClient.Destroy;
+begin
+  FreeAndNil(FWorkerThread);
+
+  inherited Destroy;
+end;
+
+
 { TX2LogNamedPipeClientWorkerThread }
-constructor TX2LogNamedPipeClientWorkerThread.Create(ALog: IX2LogBase; const APipeName: string);
+constructor TX2LogNamedPipeClientWorkerThread.Create(AClient: TX2LogNamedPipeClient; const APipeName: string);
 begin
   FTerminateEvent := TEvent.Create(nil, True, False, '');
+  FReadEvent := TEvent.Create(nil, True, False, '');
   FMessageData := TMemoryStream.Create;
 
-  FLog := ALog;
+  FClient := AClient;
   FPipeName := APipeName;
 
   inherited Create(False);
 end;
 
 
+destructor TX2LogNamedPipeClientWorkerThread.Destroy;
+begin
+  inherited Destroy;
+
+  FreeAndNil(FMessageData);
+  FreeAndNil(FReadEvent);
+  FreeAndNil(FTerminateEvent);
+end;
+
+
 procedure TX2LogNamedPipeClientWorkerThread.Execute;
 begin
   FPipeHandle := INVALID_HANDLE_VALUE;
@@ -159,15 +184,13 @@ end;
 
 procedure TX2LogNamedPipeClientWorkerThread.ReadPipe;
 var
-  readEvent: TEvent;
   events: array[0..1] of THandle;
   waitResult: Cardinal;
   bytesTransferred: Cardinal;
 
 begin
-  readEvent := TEvent.Create(nil, False, False, '');
   events[0] := TerminateEvent.Handle;
-  events[1] := readEvent.Handle;
+  events[1] := ReadEvent.Handle;
 
   FOverlappedRead.hEvent := readEvent.Handle;
   ReadMessage;
@@ -268,12 +291,17 @@ var
   header: TX2LogMessageHeaderV1;
   headerDiff: Integer;
   msg: string;
-  details: string;
+  details: IX2LogDetails;
+  serializerIID: TGUID;
+  detailsSize: Cardinal;
+  detailsStream: TMemoryStream;
+  serializer: IX2LogDetailsSerializer;
 
 begin
   if MessageData.Size > 0 then
   begin
     try
+      { Header }
       MessageData.Position := 0;
       MessageData.ReadBuffer(header, SizeOf(header));
 
@@ -288,11 +316,35 @@ begin
       end else if headerDiff < 0 then
         raise EReadError.Create('Header too small');
 
+      { Message }
       msg := ReadString;
-      details := ReadString;
 
-      // #ToDo1 named pipe support for non-string details
+      { Details }
-      Log.Log(header.Level, msg, TX2LogStringDetails.CreateIfNotEmpty(details));
+      details := nil;
+
+      MessageData.ReadBuffer(serializerIID, SizeOf(TGUID));
+      if serializerIID <> GUID_NULL then
+      begin
+        MessageData.ReadBuffer(detailsSize, SizeOf(Cardinal));
+        if detailsSize > 0 then
+        begin
+          if TX2LogDetailsRegistry.GetSerializer(serializerIID, serializer) then
+          begin
+            detailsStream := TMemoryStream.Create;
+            try
+              detailsStream.CopyFrom(MessageData, detailsSize);
+              detailsStream.Position := 0;
+
+              details := serializer.Deserialize(detailsStream);
+            finally
+              FreeAndNil(detailsStream);
+            end;
+          end else
+            MessageData.Seek(detailsSize, soFromCurrent);
+        end;
+      end;
+
+      Client.Log(header.Level, msg, details);
     except
       on E:EReadError do
         ClosePipe;

X2Log.Constants.pas

@@ -46,10 +46,10 @@ resourcestring
   { Status messages }
   LogMonitorFormStatusPaused = 'Paused: %d log message(s) skipped';
 
+  { Filter for Save details buttons }
   LogMonitorFormSaveDetailsFilter = 'All files (*.*)|*.*';
 
 
-
   function GetLogLevelText(ALogLevel: TX2LogLevel): string;
 
   function GetLogResourceString(AResourceString: Pointer): string;
@@ -62,8 +62,11 @@ uses
   System.SysUtils;
 
 
+type
+  TResourceStringDictionary = TDictionary<Pointer,string>;
+
 var
-  LogResourceStringMap: TDictionary<Pointer,string>;
+  LogResourceStringMap: TResourceStringDictionary;
 
 
 
@@ -104,7 +107,7 @@ end;
 
 
 initialization
-  LogResourceStringMap := TDictionary<Pointer,string>.Create;
+  LogResourceStringMap := TResourceStringDictionary.Create;
 
 finalization
   FreeAndNil(LogResourceStringMap);

X2Log.Details.Default.pas

@@ -17,6 +17,9 @@ type
 
     constructor Create(const AText: string);
 
+    { IX2LogDetails }
+    function GetSerializerIID: TGUID;
+
     { IX2LogDetailsText }
     function GetAsString: string;
 
@@ -36,10 +39,14 @@ type
   protected
     property Data: TStream read FData;
   public
-    constructor Create(ACopyFrom: TStream); overload;
+    constructor Create; overload;
+    constructor Create(ACopyFrom: TStream; ACount: Integer = 0); overload;
     constructor Create(AData: RawByteString); overload;
     destructor Destroy; override;
 
+    { IX2LogDetails }
+    function GetSerializerIID: TGUID;
+
     { IX2LogDetailsBinary }
     function GetAsStream: TStream;
 
@@ -51,7 +58,33 @@ type
 implementation
 uses
   System.SysUtils,
-  Vcl.ClipBrd;
+  Vcl.ClipBrd,
+
+  X2Log.Constants,
+  X2Log.Details.Registry;
+
+
+const
+  StringDetailsSerializerIID: TGUID = '{4223C30E-6E80-4D66-9EDC-F8688A7413D2}';
+  BinaryDetailsSerializerIID: TGUID = '{05F6E8BD-118E-41B3-B626-1F190CC2A7D3}';
+
+
+
+type
+  TX2LogStringDetailsSerializer = class(TInterfacedObject, IX2LogDetailsSerializer)
+  public
+    { IX2LogDetailsSerializer }
+    procedure Serialize(ADetails: IX2LogDetails; AStream: TStream);
+    function Deserialize(AStream: TStream): IX2LogDetails;
+  end;
+
+
+  TX2LogBinaryDetailsSerializer = class(TInterfacedObject, IX2LogDetailsSerializer)
+  public
+    { IX2LogDetailsSerializer }
+    procedure Serialize(ADetails: IX2LogDetails; AStream: TStream);
+    function Deserialize(AStream: TStream): IX2LogDetails;
+  end;
 
 
 { TX2LogStringDetails }
@@ -72,6 +105,12 @@ begin
 end;
 
 
+function TX2LogStringDetails.GetSerializerIID: TGUID;
+begin
+  Result := StringDetailsSerializerIID;
+end;
+
+
 function TX2LogStringDetails.GetAsString: string;
 begin
   Result := FText;
@@ -86,25 +125,33 @@ end;
 
 procedure TX2LogStringDetails.SaveToStream(AStream: TStream);
 var
-  textStream: TStringStream;
+  writer: TStreamWriter;
 
 begin
-  textStream := TStringStream.Create(GetAsString, TEncoding.ANSI, False);
+  writer := TStreamWriter.Create(AStream, TEncoding.UTF8);
   try
-    AStream.CopyFrom(textStream, 0);
+    writer.Write(GetAsString);
   finally
-    FreeAndNil(textStream);
+    FreeAndNil(writer);
   end;
 end;
 
 
 { TX2LogBinaryDetails }
-constructor TX2LogBinaryDetails.Create(ACopyFrom: TStream);
+constructor TX2LogBinaryDetails.Create;
 begin
   inherited Create;
 
   FData := TMemoryStream.Create;
-  FData.CopyFrom(ACopyFrom, ACopyFrom.Size - ACopyFrom.Position);
+end;
+
+
+constructor TX2LogBinaryDetails.Create(ACopyFrom: TStream; ACount: Integer);
+begin
+  inherited Create;
+
+  FData := TMemoryStream.Create;
+  FData.CopyFrom(ACopyFrom, ACount);
 end;
 
 
@@ -124,6 +171,12 @@ begin
 end;
 
 
+function TX2LogBinaryDetails.GetSerializerIID: TGUID;
+begin
+  Result := BinaryDetailsSerializerIID;
+end;
+
+
 function TX2LogBinaryDetails.GetAsStream: TStream;
 begin
   Data.Position := 0;
@@ -136,4 +189,77 @@ begin
   AStream.CopyFrom(Data, 0);
 end;
 
+
+{ TX2LogStringDetailsSerializer }
+procedure TX2LogStringDetailsSerializer.Serialize(ADetails: IX2LogDetails; AStream: TStream);
+var
+  bytes: TBytes;
+  bytesLength: Cardinal;
+
+begin
+  bytes := TEncoding.UTF8.GetBytes((ADetails as IX2LogDetailsText).AsString);
+  bytesLength := Length(bytes);
+
+  AStream.WriteBuffer(bytesLength, SizeOf(Cardinal));
+  if bytesLength > 0 then
+    AStream.WriteBuffer(bytes[0], bytesLength);
+end;
+
+
+function TX2LogStringDetailsSerializer.Deserialize(AStream: TStream): IX2LogDetails;
+var
+  bytes: TBytes;
+  bytesLength: Cardinal;
+
+begin
+  AStream.ReadBuffer(bytesLength, SizeOf(Cardinal));
+  if bytesLength > 0 then
+  begin
+    SetLength(bytes, bytesLength);
+    AStream.ReadBuffer(bytes[0], bytesLength);
+
+    Result := TX2LogStringDetails.Create(TEncoding.UTF8.GetString(bytes));
+  end else
+    { Do not return nil; the fact that Deserialize is called means an
+      empty Details was serialized. }
+    Result := TX2LogStringDetails.Create('');
+end;
+
+
+{ TX2LogBinaryDetailsSerializer }
+procedure TX2LogBinaryDetailsSerializer.Serialize(ADetails: IX2LogDetails; AStream: TStream);
+var
+  stream: TStream;
+  streamSize: Cardinal;
+
+begin
+  stream := (ADetails as IX2LogDetailsBinary).AsStream;
+  streamSize := stream.Size;
+
+  AStream.WriteBuffer(streamSize, SizeOf(Cardinal));
+  if streamSize > 0 then
+    AStream.CopyFrom(stream, streamSize);
+end;
+
+
+function TX2LogBinaryDetailsSerializer.Deserialize(AStream: TStream): IX2LogDetails;
+var
+  streamSize: Cardinal;
+
+begin
+  AStream.ReadBuffer(streamSize, SizeOf(Cardinal));
+  if streamSize > 0 then
+    Result := TX2LogBinaryDetails.Create(AStream, streamSize)
+  else
+    { Do not return nil; the fact that Deserialize is called means an
+      empty Details was serialized. }
+    Result := TX2LogBinaryDetails.Create;
+end;
+
+
+initialization
+  TX2LogDetailsRegistry.Register(StringDetailsSerializerIID, TX2LogStringDetailsSerializer.Create);
+  TX2LogDetailsRegistry.Register(BinaryDetailsSerializerIID, TX2LogBinaryDetailsSerializer.Create);
+
 end.
+

X2Log.Details.Registry.pas

@@ -0,0 +1,81 @@
+unit X2Log.Details.Registry;
+
+interface
+uses
+  System.Generics.Collections,
+
+  X2Log.Intf;
+
+
+type
+  TSerializerDictionary = TDictionary<TGUID, IX2LogDetailsSerializer>;
+
+  TX2LogDetailsRegistry = class(TObject)
+  private
+    class var FSerializers: TSerializerDictionary;
+  protected
+    class function Serializers: TSerializerDictionary;
+
+    class procedure CleanupSerializers;
+  public
+    class procedure Register(AIID: TGUID; ASerializer: IX2LogDetailsSerializer);
+    class procedure Unregister(AIID: TGUID);
+
+    class function GetSerializer(ASerializerIID: TGUID; out ASerializer: IX2LogDetailsSerializer): Boolean; overload;
+    class function GetSerializer(ADetails: IX2LogDetails; out ASerializer: IX2LogDetailsSerializer): Boolean; overload;
+  end;
+
+
+implementation
+uses
+  System.SysUtils,
+  System.Types;
+
+
+{ TX2LogDetailsRegistry }
+class procedure TX2LogDetailsRegistry.Register(AIID: TGUID; ASerializer: IX2LogDetailsSerializer);
+begin
+  Serializers.Add(AIID, ASerializer);
+end;
+
+
+class function TX2LogDetailsRegistry.GetSerializer(ADetails: IX2LogDetails; out ASerializer: IX2LogDetailsSerializer): Boolean;
+begin
+  Result := Assigned(ADetails) and
+            (ADetails.SerializerIID <> GUID_NULL) and
+            GetSerializer(ADetails.SerializerIID, ASerializer);
+end;
+
+
+class procedure TX2LogDetailsRegistry.Unregister(AIID: TGUID);
+begin
+  Serializers.Remove(AIID);
+end;
+
+
+class function TX2LogDetailsRegistry.GetSerializer(ASerializerIID: TGUID; out ASerializer: IX2LogDetailsSerializer): Boolean;
+begin
+  Result := Serializers.TryGetValue(ASerializerIID, ASerializer);
+end;
+
+
+class function TX2LogDetailsRegistry.Serializers: TSerializerDictionary;
+begin
+  if not Assigned(FSerializers) then
+    FSerializers := TSerializerDictionary.Create;
+
+  Result := FSerializers;
+end;
+
+
+class procedure TX2LogDetailsRegistry.CleanupSerializers;
+begin
+  FreeAndNil(FSerializers);
+end;
+
+
+initialization
+finalization
+  TX2LogDetailsRegistry.CleanupSerializers;
+
+end.

X2Log.Global.pas

@@ -10,8 +10,8 @@ uses
 
 type
   TX2GlobalLog = class(TObject)
-  private class var
+  private
-    FInstance: IX2Log;
+    class var FInstance: IX2Log;
   protected
     class procedure CleanupInstance;
   public

X2Log.Intf.pas

@@ -19,6 +19,16 @@ type
   { Details }
   IX2LogDetails = interface
     ['{86F24F52-CE1F-4A79-936F-A5805D84E18A}']
+    function GetSerializerIID: TGUID;
+
+    property SerializerIID: TGUID read GetSerializerIID;
+  end;
+
+
+  IX2LogDetailsSerializer = interface
+    ['{E75F6F4E-A671-4622-878C-F59C64FB1320}']
+    procedure Serialize(ADetails: IX2LogDetails; AStream: TStream);
+    function Deserialize(AStream: TStream): IX2LogDetails;
   end;
 
 

X2Log.Observer.MonitorForm.dfm

@@ -46,6 +46,7 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
       List = True
       ShowCaptions = True
       TabOrder = 0
+      OnCustomDraw = ToolbarCustomDraw
       object tbCopyDetails: TToolButton
         Left = 0
         Top = 0
@@ -163,6 +164,7 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
       List = True
       ShowCaptions = True
       TabOrder = 1
+      OnCustomDraw = ToolbarCustomDraw
       object tbClear: TToolButton
         Left = 0
         Top = 0
@@ -194,7 +196,7 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
     Left = 448
     Top = 48
     Bitmap = {
-      494C010109004000940010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
+      494C0101090040009C0010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
       0000000000003600000028000000400000003000000001002000000000000030
       0000000000000000000000000000000000000000000000000000000000000000
       0000000000000000000000000000000000000000000000000000000000000000

X2Log.Observer.MonitorForm.pas

@@ -4,6 +4,7 @@ interface
 uses
   System.Classes,
   System.Generics.Collections,
+  System.Types,
   Vcl.ActnList, 
   Vcl.ComCtrls,
   Vcl.Controls,
@@ -24,6 +25,10 @@ const
 
 
 type
+  TX2LogObserverMonitorForm = class;
+  TMonitorFormDictionary = TObjectDictionary<IX2LogObservable,TX2LogObserverMonitorForm>;
+
+
   TX2LogObserverMonitorForm = class(TForm, IX2LogObserver)
     vstLog: TVirtualStringTree;
     ilsLog: TImageList;
@@ -59,18 +64,19 @@ type
     procedure actCopyDetailsExecute(Sender: TObject);
     procedure actSaveDetailsExecute(Sender: TObject);
     procedure actPauseExecute(Sender: TObject);
+    procedure ToolbarCustomDraw(Sender: TToolBar; const ARect: TRect; var DefaultDraw: Boolean);
   private class var
-    FInstances: TObjectDictionary<IX2Log,TX2LogObserverMonitorForm>;
+    FInstances: TMonitorFormDictionary;
   private
     FFreeOnClose: Boolean;
-    FLogToAttach: IX2Log;
+    FLogObservable: IX2LogObservable;
     FLogAttached: Boolean;
     FPausedLogCount: Integer;
     FDetails: IX2LogDetails;
 
     function GetPaused: Boolean;
   protected
-    class function GetInstance(ALog: IX2Log; out AForm: TX2LogObserverMonitorForm): Boolean;
+    class function GetInstance(ALog: IX2LogObservable; out AForm: TX2LogObserverMonitorForm): Boolean;
     class procedure RemoveInstance(AForm: TX2LogObserverMonitorForm);
     class procedure CleanupInstances;
 
@@ -86,17 +92,17 @@ type
     procedure SetBinaryDetails(ADetails: IX2LogDetailsBinary);
 
     property Details: IX2LogDetails read FDetails;
-    property LogToAttach: IX2Log read FLogToAttach;
+    property LogObservable: IX2LogObservable read FLogObservable;
     property LogAttached: Boolean read FLogAttached;
     property Paused: Boolean read GetPaused;
     property PausedLogCount: Integer read FPausedLogCount write FPausedLogCount;
   public
-    class function Instance(ALog: IX2Log): TX2LogObserverMonitorForm;
+    class function Instance(ALog: IX2LogObservable): TX2LogObserverMonitorForm;
 
-    class procedure ShowInstance(ALog: IX2Log);
+    class procedure ShowInstance(ALog: IX2LogObservable);
-    class procedure CloseInstance(ALog: IX2Log);
+    class procedure CloseInstance(ALog: IX2LogObservable);
 
-    constructor Create(AOwner: TComponent; ALogToAttach: IX2Log = nil); reintroduce;
+    constructor Create(AOwner: TComponent; ALogObservable: IX2LogObservable = nil); reintroduce;
     destructor Destroy; override;
 
     { IX2LogObserver }
@@ -112,6 +118,7 @@ uses
   System.Math,
   System.SysUtils,
   Vcl.Clipbrd,
+  Vcl.Themes,
   Winapi.Windows,
 
   X2Log.Constants;
@@ -150,17 +157,17 @@ end;
 
 
 { TX2LogObserverMonitorForm }
-class function TX2LogObserverMonitorForm.Instance(ALog: IX2Log): TX2LogObserverMonitorForm;
+class function TX2LogObserverMonitorForm.Instance(ALog: IX2LogObservable): TX2LogObserverMonitorForm;
 var
-  log: IX2Log;
+  log: IX2LogObservable;
 
 begin
   { Explicit cast ensures we're getting the same pointer every time if, for example,
     the implementing interface is a descendant of IX2Log }
-  log := (ALog as IX2Log);
+  log := (ALog as IX2LogObservable);
 
   if not Assigned(FInstances) then
-    FInstances := TObjectDictionary<IX2Log,TX2LogObserverMonitorForm>.Create([doOwnsValues]);
+    FInstances := TMonitorFormDictionary.Create([doOwnsValues]);
 
   if not FInstances.TryGetValue(log, Result) then
   begin
@@ -172,13 +179,13 @@ begin
 end;
 
 
-class procedure TX2LogObserverMonitorForm.ShowInstance(ALog: IX2Log);
+class procedure TX2LogObserverMonitorForm.ShowInstance(ALog: IX2LogObservable);
 begin
   Instance(ALog).Show;
 end;
 
 
-class procedure TX2LogObserverMonitorForm.CloseInstance(ALog: IX2Log);
+class procedure TX2LogObserverMonitorForm.CloseInstance(ALog: IX2LogObservable);
 var
   monitorForm: TX2LogObserverMonitorForm;
 
@@ -188,7 +195,7 @@ begin
 end;
 
 
-class function TX2LogObserverMonitorForm.GetInstance(ALog: IX2Log; out AForm: TX2LogObserverMonitorForm): Boolean;
+class function TX2LogObserverMonitorForm.GetInstance(ALog: IX2LogObservable; out AForm: TX2LogObserverMonitorForm): Boolean;
 begin
   Result := False;
 
@@ -199,7 +206,7 @@ end;
 
 class procedure TX2LogObserverMonitorForm.RemoveInstance(AForm: TX2LogObserverMonitorForm);
 var
-  log: IX2Log;
+  log: IX2LogObservable;
 
 begin
   if Assigned(FInstances) then
@@ -223,14 +230,14 @@ begin
 end;
 
 
-constructor TX2LogObserverMonitorForm.Create(AOwner: TComponent; ALogToAttach: IX2Log);
+constructor TX2LogObserverMonitorForm.Create(AOwner: TComponent; ALogObservable: IX2LogObservable);
 var
   captionFormat: string;
 
 begin
   inherited Create(AOwner);
 
-  FLogToAttach := ALogToAttach;
+  FLogObservable := ALogObservable;
 
   captionFormat := GetLogResourceString(@LogMonitorFormCaption);
   if Pos('%s', captionFormat) > 0 then
@@ -262,8 +269,8 @@ end;
 
 destructor TX2LogObserverMonitorForm.Destroy;
 begin
-  if Assigned(FLogToAttach) and FLogAttached then
+  if Assigned(FLogObservable) and FLogAttached then
-    FLogToAttach.Detach(Self);
+    FLogObservable.Detach(Self);
 
   RemoveInstance(Self);
 
@@ -273,9 +280,9 @@ end;
 
 procedure TX2LogObserverMonitorForm.FormShow(Sender: TObject);
 begin
-  if Assigned(FLogToAttach) and (not FLogAttached) then
+  if Assigned(FLogObservable) and (not FLogAttached) then
   begin
-    FLogToAttach.Attach(Self);
+    FLogObservable.Attach(Self);
     FLogAttached := True;
   end;
 end;
@@ -283,9 +290,9 @@ end;
 
 procedure TX2LogObserverMonitorForm.FormClose(Sender: TObject; var Action: TCloseAction);
 begin
-  if Assigned(FLogToAttach) and FLogAttached then
+  if Assigned(FLogObservable) and FLogAttached then
   begin
-    FLogToAttach.Detach(Self);
+    FLogObservable.Detach(Self);
     FLogAttached := False;
   end;
 
@@ -628,6 +635,24 @@ begin
 end;
 
 
+procedure TX2LogObserverMonitorForm.ToolbarCustomDraw(Sender: TToolBar; const ARect: TRect; var DefaultDraw: Boolean);
+var
+  element: TThemedElementDetails;
+  rect: TRect;
+
+begin
+  if StyleServices.Enabled then
+  begin
+    rect := Sender.ClientRect;
+    if Assigned(Self.Menu) then
+      Dec(rect.Top, GetSystemMetrics(SM_CYMENU));
+
+    element := StyleServices.GetElementDetails(trRebarRoot);
+    StyleServices.DrawElement(Sender.Canvas.Handle, element, rect);
+  end;
+end;
+
+
 initialization
 finalization
   TX2LogObserverMonitorForm.CleanupInstances;

X2Log.Observer.NamedPipe.pas

@@ -24,7 +24,10 @@ uses
   System.Generics.Collections,
   System.SyncObjs,
   System.SysUtils,
-  Winapi.Windows;
+  System.Types,
+  Winapi.Windows,
+
+  X2Log.Details.Registry;
 
 
 type
@@ -128,11 +131,9 @@ end;
 
 destructor TX2LogNamedPipeClient.Destroy;
 begin
+  Disconnect;
+
   FreeAndNil(FOverlappedEvent);
-
-  if PipeHandle <> INVALID_HANDLE_VALUE then
-    DisconnectNamedPipe(PipeHandle);
-
   ClearWriteBuffer;
 
   inherited Destroy;
@@ -185,6 +186,7 @@ begin
   begin
     CancelIo(PipeHandle);
     DisconnectNamedPipe(PipeHandle);
+    CloseHandle(PipeHandle);
 
     FPipeHandle := INVALID_HANDLE_VALUE;
   end;
@@ -208,26 +210,49 @@ var
   header: TX2LogMessageHeader;
   bytesWritten: Cardinal;
   lastError: Cardinal;
-  logDetailsText: IX2LogDetailsText;
+  detailsSize: Cardinal;
+  detailsStream: TMemoryStream;
+  serializerIID: TGUID;
+  serializer: IX2LogDetailsSerializer;
 
 begin
   ClearWriteBuffer;
 
   FWriteBuffer := TMemoryStream.Create;
 
+  { Header }
   header.ID := X2LogMessageHeader;
   header.Version := X2LogMessageVersion;
   header.Size := SizeOf(header);
   header.Level := AEntry.Level;
 
   WriteBuffer.WriteBuffer(header, SizeOf(header));
+
+  { Message }
   WriteString(AEntry.Message);
 
-  // #ToDo1 support for non-string details
+  { Details }
-  if Supports(AEntry.Details, IX2LogDetailsText, logDetailsText) then
+  if TX2LogDetailsRegistry.GetSerializer(AEntry.Details, serializer) then
-    WriteString(logDetailsText.AsString)
+  begin
-  else
+    detailsStream := TMemoryStream.Create;
-    WriteString('');
+    try
+      serializer.Serialize(AEntry.Details, detailsStream);
+
+      serializerIID := AEntry.Details.SerializerIID;
+      WriteBuffer.WriteBuffer(serializerIID, SizeOf(TGUID));
+
+      detailsSize := detailsStream.Size;
+      WriteBuffer.WriteBuffer(detailsSize, SizeOf(Cardinal));
+      WriteBuffer.CopyFrom(detailsStream, 0);
+    finally
+      FreeAndNil(detailsStream);
+    end;
+  end else
+  begin
+    serializerIID := GUID_NULL;
+    WriteBuffer.WriteBuffer(serializerIID, SizeOf(TGUID));
+  end;
+
 
   Result := WriteFile(Pipe, WriteBuffer.Memory^, WriteBuffer.Size, bytesWritten, @Overlapped);
   if not Result then
@@ -412,18 +437,19 @@ begin
   { Thanks to: http://www.osronline.com/showthread.cfm?link=204207
           and: http://www.netid.washington.edu/documentation/domains/sddl.aspx
 
-      0x12018d =
+      0x12019f =
          0x00100000 - SYNCHRONIZE
          0x00020000 - READ_CONTROL
          0x00000100 - FILE_WRITE_ATTRIBUTES
          0x00000080 - FILE_READ_ATTRIBUTES
+         0x00000010 - FILE_WRITE_EA
          0x00000008 - FILE_READ_EA
          0x00000004 - FILE_CREATE_PIPE_INSTANCE
+         0x00000002 - FILE_WRITE_DATA
          0x00000001 - FILE_READ_DATA }
   if ConvertStringSecurityDescriptorToSecurityDescriptorW('D:' +                  // Discretionary ACL
                                                           '(D;;FA;;;NU)' +        // Deny file all access (FA) to network user access (NU)
-                                                          '(A;;0x12018d;;;WD)' +  // Allow specific permissions for everyone (WD)
+                                                          '(A;;0x12019f;;;WD)',   // Allow permissions for everyone (WD)
-                                                          '(A;;0x12018d;;;CO)',   // Allow specific permissions for creator owner (CO)
                                                           SDDL_REVISION_1,
                                                           @security.lpSecurityDescriptor,
                                                           nil) then
@@ -452,6 +478,8 @@ begin
           begin
             client.State := Connected;
             Clients.Add(client);
+
+            AddListener;
           end;
       else
         { Error occured }