diff --git a/NamedPipeClient/X2LogNamedPipeClient.dpr b/NamedPipeClient/X2LogNamedPipeClient.dpr
index 3247b8b..1ba60ff 100644
--- a/NamedPipeClient/X2LogNamedPipeClient.dpr
+++ b/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.Run;
+ Application.Title := 'X˛Log Named Pipe Client';
+
+ client := TX2LogNamedPipeClient.Create('X2LogTest');
+ try
+ observerForm := TX2LogObserverMonitorForm.Instance(client);
+ observerForm.ShowModal;
+ finally
+ client := nil;
+ end;
end.
diff --git a/NamedPipeClient/X2LogNamedPipeClient.dproj b/NamedPipeClient/X2LogNamedPipeClient.dproj
index 31e113e..4070c8d 100644
--- a/NamedPipeClient/X2LogNamedPipeClient.dproj
+++ b/NamedPipeClient/X2LogNamedPipeClient.dproj
@@ -84,10 +84,6 @@
MainSource
-
-
- dfm
-
Cfg_2
Base
diff --git a/NamedPipeClient/source/MainFrm.dfm b/NamedPipeClient/source/MainFrm.dfm
deleted file mode 100644
index b9ae385..0000000
--- a/NamedPipeClient/source/MainFrm.dfm
+++ /dev/null
@@ -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
diff --git a/NamedPipeClient/source/MainFrm.pas b/NamedPipeClient/source/MainFrm.pas
deleted file mode 100644
index 6c7e2aa..0000000
--- a/NamedPipeClient/source/MainFrm.pas
+++ /dev/null
@@ -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.
diff --git a/Test/X2LogTest.dpr b/Test/X2LogTest.dpr
index 8f9c362..6fcbb59 100644
--- a/Test/X2LogTest.dpr
+++ b/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}
diff --git a/Test/X2LogTest.dproj b/Test/X2LogTest.dproj
index 2b51c10..f7074ff 100644
--- a/Test/X2LogTest.dproj
+++ b/Test/X2LogTest.dproj
@@ -186,12 +186,12 @@
- dfm
+
Cfg_2
Base
diff --git a/Test/source/MainFrm.dfm b/Test/source/MainFrm.dfm
index d249469..b43cd55 100644
--- a/Test/source/MainFrm.dfm
+++ b/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
diff --git a/Test/source/MainFrm.pas b/Test/source/MainFrm.pas
index efd34fb..3dd4fff 100644
--- a/Test/source/MainFrm.pas
+++ b/Test/source/MainFrm.pas
@@ -52,8 +52,8 @@ type
tsBinary: TTabSheet;
pnlDispatch: TPanel;
bvlDispatch: TBevel;
- Panel1: TPanel;
- Bevel1: TBevel;
+ pnlObservers: TPanel;
+ bvlObservers: TBevel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
diff --git a/X2Log.Client.NamedPipe.pas b/X2Log.Client.NamedPipe.pas
index 0571606..3bfae15 100644
--- a/X2Log.Client.NamedPipe.pas
+++ b/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
- Log.Log(header.Level, msg, TX2LogStringDetails.CreateIfNotEmpty(details));
+ { 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;
diff --git a/X2Log.Constants.pas b/X2Log.Constants.pas
index b855063..696d392 100644
--- a/X2Log.Constants.pas
+++ b/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;
+
var
- LogResourceStringMap: TDictionary;
+ LogResourceStringMap: TResourceStringDictionary;
@@ -104,7 +107,7 @@ end;
initialization
- LogResourceStringMap := TDictionary.Create;
+ LogResourceStringMap := TResourceStringDictionary.Create;
finalization
FreeAndNil(LogResourceStringMap);
diff --git a/X2Log.Details.Default.pas b/X2Log.Details.Default.pas
index 457881f..968dbed 100644
--- a/X2Log.Details.Default.pas
+++ b/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.
+
diff --git a/X2Log.Details.Registry.pas b/X2Log.Details.Registry.pas
new file mode 100644
index 0000000..b80d3dd
--- /dev/null
+++ b/X2Log.Details.Registry.pas
@@ -0,0 +1,81 @@
+unit X2Log.Details.Registry;
+
+interface
+uses
+ System.Generics.Collections,
+
+ X2Log.Intf;
+
+
+type
+ TSerializerDictionary = TDictionary;
+
+ 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.
diff --git a/X2Log.Global.pas b/X2Log.Global.pas
index 37c4756..1356d01 100644
--- a/X2Log.Global.pas
+++ b/X2Log.Global.pas
@@ -10,8 +10,8 @@ uses
type
TX2GlobalLog = class(TObject)
- private class var
- FInstance: IX2Log;
+ private
+ class var FInstance: IX2Log;
protected
class procedure CleanupInstance;
public
diff --git a/X2Log.Intf.pas b/X2Log.Intf.pas
index b215fdb..fba25dc 100644
--- a/X2Log.Intf.pas
+++ b/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;
diff --git a/X2Log.Observer.MonitorForm.dfm b/X2Log.Observer.MonitorForm.dfm
index 64a12af..68d204b 100644
--- a/X2Log.Observer.MonitorForm.dfm
+++ b/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
diff --git a/X2Log.Observer.MonitorForm.pas b/X2Log.Observer.MonitorForm.pas
index 8528962..c594af6 100644
--- a/X2Log.Observer.MonitorForm.pas
+++ b/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;
+
+
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;
+ 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 CloseInstance(ALog: IX2Log);
+ class procedure ShowInstance(ALog: IX2LogObservable);
+ 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.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
- FLogToAttach.Detach(Self);
+ if Assigned(FLogObservable) and FLogAttached then
+ 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;
diff --git a/X2Log.Observer.NamedPipe.pas b/X2Log.Observer.NamedPipe.pas
index b451315..b1ecc22 100644
--- a/X2Log.Observer.NamedPipe.pas
+++ b/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
- if Supports(AEntry.Details, IX2LogDetailsText, logDetailsText) then
- WriteString(logDetailsText.AsString)
- else
- WriteString('');
+ { Details }
+ if TX2LogDetailsRegistry.GetSerializer(AEntry.Details, serializer) then
+ begin
+ detailsStream := TMemoryStream.Create;
+ 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;;0x12018d;;;CO)', // Allow specific permissions for creator owner (CO)
+ '(A;;0x12019f;;;WD)', // Allow permissions for everyone (WD)
SDDL_REVISION_1,
@security.lpSecurityDescriptor,
nil) then
@@ -452,6 +478,8 @@ begin
begin
client.State := Connected;
Clients.Add(client);
+
+ AddListener;
end;
else
{ Error occured }