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 - -
MainForm
- 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 @@
X2LogObserverMonitorForm
- 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 }