GitHub-Mirror/x2log
1
0
Fork 0
mirror of synced 2024-09-07 21:55:05 +00:00
Code Issues Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Mark van Renswoude 2014-05-31 20:10:10 +00:00
parent a3fd535be7
commit a9cf1b75f6
17 changed files with 418 additions and 159 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
NamedPipeClient/X2LogNamedPipeClient.dpr
View File

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

4
NamedPipeClient/X2LogNamedPipeClient.dproj
View File

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

27
NamedPipeClient/source/MainFrm.dfm
View File

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

52
NamedPipeClient/source/MainFrm.pas
View File

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

4
Test/X2LogTest.dpr
View File

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

2
Test/X2LogTest.dproj
View File

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

6
Test/source/MainFrm.dfm
View File

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

4
Test/source/MainFrm.pas
View File

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

78
X2Log.Client.NamedPipe.pas
View File

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

9
X2Log.Constants.pas
View File

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

142
X2Log.Details.Default.pas
View File

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

81
X2Log.Details.Registry.pas Normal file
View File

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

4
X2Log.Global.pas
View File

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

10
X2Log.Intf.pas
View File

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

4
X2Log.Observer.MonitorForm.dfm
View File

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

73
X2Log.Observer.MonitorForm.pas
View File

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

56
X2Log.Observer.NamedPipe.pas
View File

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