diff --git a/Packages/X2LogDXE2.dproj b/Packages/X2LogDXE2.dproj
index 834c5b3..6248116 100644
--- a/Packages/X2LogDXE2.dproj
+++ b/Packages/X2LogDXE2.dproj
@@ -5,35 +5,41 @@
13.4
VCL
True
- Debug
+ Build
Win32
- 1
+ 3
Package
true
+
+ true
+ Base
+ true
+
true
Base
true
-
+
true
Base
true
+
+ true
+ Cfg_1
+ true
+ true
+
true
Cfg_1
true
true
-
- true
- Base
- true
-
false
All
@@ -49,11 +55,18 @@
$(DELPHILIB)
.\$(Platform)\$(Config)
+
+ true
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
+ $(DELPHIBIN64)
+ $(DELPHIBIN64)
+ $(DELPHILIB64)
+ 1033
+
true
Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
1033
- CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=
DEBUG;$(DCC_Define)
@@ -62,17 +75,15 @@
true
true
+
+ true
+ 1033
+
true
1033
false
-
- false
- RELEASE;$(DCC_Define)
- 0
- false
-
MainSource
@@ -96,14 +107,10 @@
-
- Cfg_2
- Base
-
Base
-
+
Cfg_1
Base
@@ -147,7 +154,7 @@
- False
+ True
False
True
diff --git a/Packages/X2LogDXE2.res b/Packages/X2LogDXE2.res
index a64cea3..27efe49 100644
Binary files a/Packages/X2LogDXE2.res and b/Packages/X2LogDXE2.res differ
diff --git a/Packages/X2LogFormsDXE2.dproj b/Packages/X2LogFormsDXE2.dproj
index 2d00ebf..b423e99 100644
--- a/Packages/X2LogFormsDXE2.dproj
+++ b/Packages/X2LogFormsDXE2.dproj
@@ -7,12 +7,17 @@
True
Debug
Win32
- 1
+ 3
Package
true
+
+ true
+ Base
+ true
+
true
Base
@@ -23,6 +28,12 @@
Base
true
+
+ true
+ Cfg_1
+ true
+ true
+
true
Cfg_1
@@ -49,6 +60,14 @@
$(DELPHILIB)
.\$(Platform)\$(Config)
+
+ true
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
+ $(DELPHIBIN64)
+ $(DELPHIBIN64)
+ $(DELPHILIB64)
+ 1033
+
true
Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
@@ -62,6 +81,10 @@
true
true
+
+ true
+ 1033
+
true
1033
@@ -135,7 +158,7 @@
- False
+ True
False
True
diff --git a/Packages/X2LogFormsDXE2.res b/Packages/X2LogFormsDXE2.res
index a64cea3..27efe49 100644
Binary files a/Packages/X2LogFormsDXE2.res and b/Packages/X2LogFormsDXE2.res differ
diff --git a/Packages/X2LogMadExceptDXE2.dproj b/Packages/X2LogMadExceptDXE2.dproj
index 29bb798..7c35289 100644
--- a/Packages/X2LogMadExceptDXE2.dproj
+++ b/Packages/X2LogMadExceptDXE2.dproj
@@ -7,12 +7,17 @@
True
Debug
Win32
- 1
+ 3
Package
true
+
+ true
+ Base
+ true
+
true
Base
@@ -23,6 +28,12 @@
Base
true
+
+ true
+ Cfg_1
+ true
+ true
+
true
Cfg_1
@@ -49,11 +60,18 @@
$(DELPHILIB)
.\$(Platform)\$(Config)
+
+ true
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
+ $(DELPHIBIN64)
+ $(DELPHIBIN64)
+ $(DELPHILIB64)
+ 1033
+
true
Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
1033
- CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=
DEBUG;$(DCC_Define)
@@ -62,6 +80,10 @@
true
true
+
+ true
+ 1033
+
true
1033
@@ -134,7 +156,7 @@
- False
+ True
False
True
diff --git a/Packages/X2LogMadExceptDXE2.res b/Packages/X2LogMadExceptDXE2.res
index a64cea3..27efe49 100644
Binary files a/Packages/X2LogMadExceptDXE2.res and b/Packages/X2LogMadExceptDXE2.res differ
diff --git a/Test/source/MainFrm.dfm b/Test/source/MainFrm.dfm
index 93c5c88..7b565f6 100644
--- a/Test/source/MainFrm.dfm
+++ b/Test/source/MainFrm.dfm
@@ -130,8 +130,6 @@ object MainForm: TMainForm
end
object tsNamedPipe: TTabSheet
Caption = 'Named Pipe'
- ExplicitLeft = 16
- ExplicitTop = 33
DesignSize = (
587
299)
@@ -230,6 +228,42 @@ object MainForm: TMainForm
Caption = 'Monitor Form Observer'
TabOrder = 0
OnClick = btnMonitorFormClick
+ ExplicitLeft = 151
+ ExplicitTop = -6
+ end
+ object btnLock: TButton
+ AlignWithMargins = True
+ Left = 151
+ Top = 0
+ Width = 64
+ Height = 25
+ Margins.Left = 6
+ Margins.Top = 0
+ Margins.Right = 0
+ Margins.Bottom = 0
+ Align = alLeft
+ Cancel = True
+ Caption = 'Lock'
+ TabOrder = 2
+ OnClick = btnLockClick
+ ExplicitLeft = 149
+ end
+ object btnUnlock: TButton
+ AlignWithMargins = True
+ Left = 221
+ Top = 0
+ Width = 64
+ Height = 25
+ Margins.Left = 6
+ Margins.Top = 0
+ Margins.Right = 0
+ Margins.Bottom = 0
+ Align = alLeft
+ Cancel = True
+ Caption = 'Unlock'
+ TabOrder = 3
+ OnClick = btnUnlockClick
+ ExplicitLeft = 359
end
end
object pcDispatch: TPageControl
@@ -424,7 +458,7 @@ object MainForm: TMainForm
Left = 552
Top = 176
Bitmap = {
- 494C01010200140044000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
+ 494C01010200140048000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000300000000C00000001002000000000000009
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
diff --git a/Test/source/MainFrm.pas b/Test/source/MainFrm.pas
index 37f521f..6b88c33 100644
--- a/Test/source/MainFrm.pas
+++ b/Test/source/MainFrm.pas
@@ -59,6 +59,8 @@ type
lblNamedPipeServers: TLabel;
btnNamedPipeRefresh: TButton;
lbNamedPipeServers: TListBox;
+ btnLock: TButton;
+ btnUnlock: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
@@ -68,6 +70,8 @@ type
procedure edtMessageKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure btnExceptionClick(Sender: TObject);
procedure btnMonitorFormClick(Sender: TObject);
+ procedure btnLockClick(Sender: TObject);
+ procedure btnUnlockClick(Sender: TObject);
procedure btnEventStartClick(Sender: TObject);
procedure btnEventStopClick(Sender: TObject);
procedure btnFileStartClick(Sender: TObject);
@@ -134,6 +138,8 @@ begin
pcDispatch.ActivePageIndex := 0;
pcObservers.ActivePageIndex := 0;
+
+ DefaultMaxEntries := 10;
end;
@@ -243,6 +249,18 @@ begin
end;
+procedure TMainForm.btnLockClick(Sender: TObject);
+begin
+ TX2LogObserverMonitorForm.LockInstance(FLog);
+end;
+
+
+procedure TMainForm.btnUnlockClick(Sender: TObject);
+begin
+ TX2LogObserverMonitorForm.UnlockInstance(FLog);
+end;
+
+
procedure TMainForm.btnEventStartClick(Sender: TObject);
begin
if not Assigned(FEventObserver) then
@@ -321,7 +339,6 @@ begin
end;
-
procedure TMainForm.btnNamedPipeRefreshClick(Sender: TObject);
var
server: TX2LogNamedPipeServerInfo;
diff --git a/X2Log.Observer.MonitorForm.dfm b/X2Log.Observer.MonitorForm.dfm
index 8400e58..b13b701 100644
--- a/X2Log.Observer.MonitorForm.dfm
+++ b/X2Log.Observer.MonitorForm.dfm
@@ -156,7 +156,6 @@ object X2LogObserverMonitorForm: TX2LogObserverMonitorForm
OnGetText = vstLogGetText
OnGetImageIndex = vstLogGetImageIndex
OnGetHint = vstLogGetHint
- OnInitNode = vstLogInitNode
Columns = <
item
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coShowDropMark, coVisible, coAllowFocus]
diff --git a/X2Log.Observer.MonitorForm.pas b/X2Log.Observer.MonitorForm.pas
index 24bbf62..d87dfb1 100644
--- a/X2Log.Observer.MonitorForm.pas
+++ b/X2Log.Observer.MonitorForm.pas
@@ -25,6 +25,10 @@ const
CM_REENABLE = WM_APP + 1;
+var
+ DefaultMaxEntries: Cardinal = 1000;
+
+
type
TX2LogObserverMonitorForm = class;
TMonitorFormDictionary = TObjectDictionary;
@@ -66,7 +70,6 @@ type
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure vstLogInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
procedure vstLogFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vstLogGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
procedure vstLogGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string);
@@ -85,11 +88,14 @@ type
FInstances: TMonitorFormDictionary;
private
FFreeOnClose: Boolean;
+ FClosed: Boolean;
+ FLockCount: Integer;
FLogObservable: IX2LogObservable;
FLogAttached: Boolean;
FPausedLogCount: Integer;
FDetails: IX2LogDetails;
FVisibleLevels: TX2LogLevels;
+ FMaxEntries: Cardinal;
protected
class function GetInstance(ALog: IX2LogObservable; out AForm: TX2LogObserverMonitorForm): Boolean;
class procedure RemoveInstance(AForm: TX2LogObserverMonitorForm);
@@ -100,6 +106,9 @@ type
procedure WMEnable(var Msg: TWMEnable); message WM_ENABLE;
procedure CMReenable(var Msg: TMessage); message CM_REENABLE;
+ procedure AttachLog;
+ procedure DetachLog;
+
procedure UpdateUI;
procedure UpdateStatus;
procedure UpdateFilter;
@@ -113,7 +122,9 @@ type
procedure SetVisibleDetails(AControl: TControl);
+ property Closed: Boolean read FClosed;
property Details: IX2LogDetails read FDetails;
+ property LockCount: Integer read FLockCount;
property LogObservable: IX2LogObservable read FLogObservable;
property LogAttached: Boolean read FLogAttached;
property Paused: Boolean read GetPaused;
@@ -122,16 +133,25 @@ type
public
class function Instance(ALog: IX2LogObservable): TX2LogObserverMonitorForm;
+ { Locked instances will always receive log messages, but will not be visible until
+ ShowInstance is called and will hide instead of closing until UnlockInstance is called. }
+ class procedure LockInstance(ALog: IX2LogObservable);
+ class procedure UnlockInstance(ALog: IX2LogObservable);
+
class procedure ShowInstance(ALog: IX2LogObservable);
class procedure CloseInstance(ALog: IX2LogObservable);
constructor Create(AOwner: TComponent; ALogObservable: IX2LogObservable = nil); reintroduce;
destructor Destroy; override;
+ procedure Lock;
+ procedure Unlock;
+
{ IX2LogObserver }
procedure Log(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
property FreeOnClose: Boolean read FFreeOnClose write FFreeOnClose;
+ property MaxEntries: Cardinal read FMaxEntries write FMaxEntries;
end;
@@ -153,11 +173,12 @@ uses
type
TLogEntryNodeData = record
Time: TDateTime;
+ Paused: Boolean;
Level: TX2LogLevel;
Message: string;
Details: IX2LogDetails;
- procedure Initialize(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
+ procedure Initialize(APaused: Boolean; ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
end;
PLogEntryNodeData = ^TLogEntryNodeData;
@@ -172,9 +193,10 @@ const
{ TLogEntryNode }
-procedure TLogEntryNodeData.Initialize(ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
+procedure TLogEntryNodeData.Initialize(APaused: Boolean; ALevel: TX2LogLevel; const AMessage: string; ADetails: IX2LogDetails);
begin
Self.Time := Now;
+ Self.Paused := APaused;
Self.Level := ALevel;
Self.Message := AMessage;
Self.Details := ADetails;
@@ -204,6 +226,18 @@ begin
end;
+class procedure TX2LogObserverMonitorForm.LockInstance(ALog: IX2LogObservable);
+begin
+ Instance(ALog).Lock;
+end;
+
+
+class procedure TX2LogObserverMonitorForm.UnlockInstance(ALog: IX2LogObservable);
+begin
+ Instance(ALog).Unlock;
+end;
+
+
class procedure TX2LogObserverMonitorForm.ShowInstance(ALog: IX2LogObservable);
begin
Instance(ALog).Show;
@@ -262,7 +296,9 @@ var
begin
inherited Create(AOwner);
+ FClosed := True;
FLogObservable := ALogObservable;
+ FMaxEntries := DefaultMaxEntries;
captionFormat := GetLogResourceString(@LogMonitorFormCaption);
if Pos('%s', captionFormat) > 0 then
@@ -300,18 +336,7 @@ begin
end;
-destructor TX2LogObserverMonitorForm.Destroy;
-begin
- if Assigned(FLogObservable) and FLogAttached then
- FLogObservable.Detach(Self);
-
- RemoveInstance(Self);
-
- inherited Destroy;
-end;
-
-
-procedure TX2LogObserverMonitorForm.FormShow(Sender: TObject);
+procedure TX2LogObserverMonitorForm.AttachLog;
begin
if Assigned(FLogObservable) and (not FLogAttached) then
begin
@@ -321,18 +346,67 @@ begin
end;
-procedure TX2LogObserverMonitorForm.FormClose(Sender: TObject; var Action: TCloseAction);
+procedure TX2LogObserverMonitorForm.DetachLog;
begin
if Assigned(FLogObservable) and FLogAttached then
begin
FLogObservable.Detach(Self);
FLogAttached := False;
end;
+end;
- if FreeOnClose then
- Action := caFree
- else
+
+procedure TX2LogObserverMonitorForm.Lock;
+begin
+ Inc(FLockCount);
+ AttachLog;
+end;
+
+
+procedure TX2LogObserverMonitorForm.Unlock;
+begin
+ if FLockCount > 0 then
+ begin
+ Dec(FLockCount);
+
+ { Lock may have prevented a proper close, try again }
+ if Closed then
+ Close;
+ end;
+end;
+
+
+destructor TX2LogObserverMonitorForm.Destroy;
+begin
+ DetachLog;
+ RemoveInstance(Self);
+
+ inherited Destroy;
+end;
+
+
+procedure TX2LogObserverMonitorForm.FormShow(Sender: TObject);
+begin
+ FClosed := False;
+ AttachLog;
+end;
+
+
+procedure TX2LogObserverMonitorForm.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+ if LockCount = 0 then
+ begin
+ DetachLog;
+
+ if FreeOnClose then
+ Action := caFree
+ else
+ Action := caHide;
+ end else
+ begin
Action := caHide;
+ FClosed := True;
+ end;
end;
@@ -350,21 +424,35 @@ begin
scroll: Boolean;
begin
- if not Paused then
- begin
- scroll := (vstLog.RootNodeCount > 0) and (vstLog.BottomNode = vstLog.GetLast);
+ scroll := (not Paused) and (vstLog.RootNodeCount > 0) and (vstLog.BottomNode = vstLog.GetLast);
+ vstLog.BeginUpdate;
+ try
node := vstLog.AddChild(nil);
nodeData := vstLog.GetNodeData(node);
- nodeData^.Initialize(ALevel, AMessage, ADetails);
- vstLog.IsVisible[node] := (ALevel in VisibleLevels);
+ { BeginUpdate causes OnInitNode to be triggered on-demand,
+ moved Initialize call here }
+ Initialize(nodeData^);
+ nodeData^.Initialize(Paused, ALevel, AMessage, ADetails);
- if scroll then
- vstLog.ScrollIntoView(node, False);
+ vstLog.IsVisible[node] := (not Paused) and (ALevel in VisibleLevels);
- UpdateUI;
- end else
+
+ while vstLog.RootNodeCount > MaxEntries do
+ vstLog.DeleteNode(vstLog.GetFirst);
+ finally
+ vstLog.EndUpdate;
+ end;
+
+
+
+ if scroll then
+ vstLog.ScrollIntoView(node, False);
+
+ UpdateUI;
+
+ if Paused then
begin
PausedLogCount := PausedLogCount + 1;
UpdateStatus;
@@ -413,7 +501,7 @@ begin
for node in vstLog.Nodes do
begin
nodeData := vstLog.GetNodeData(node);
- vstLog.IsVisible[node] := (nodeData^.Level in VisibleLevels);
+ vstLog.IsVisible[node] := (not nodeData^.Paused) and (nodeData^.Level in VisibleLevels);
end;
finally
vstLog.EndUpdate;
@@ -594,17 +682,6 @@ begin
end;
-procedure TX2LogObserverMonitorForm.vstLogInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
- var InitialStates: TVirtualNodeInitStates);
-var
- nodeData: PLogEntryNodeData;
-
-begin
- nodeData := Sender.GetNodeData(Node);
- Initialize(nodeData^);
-end;
-
-
procedure TX2LogObserverMonitorForm.vstLogFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
nodeData: PLogEntryNodeData;
@@ -727,7 +804,31 @@ end;
procedure TX2LogObserverMonitorForm.actPauseExecute(Sender: TObject);
+var
+ node: PVirtualNode;
+ nodeData: PLogEntryNodeData;
+
begin
+ if not Paused then
+ begin
+ { Clear Paused status from nodes }
+ vstLog.BeginUpdate;
+ try
+ for node in vstLog.Nodes do
+ begin
+ nodeData := vstLog.GetNodeData(node);
+
+ if nodeData^.Paused then
+ begin
+ nodeData^.Paused := False;
+ vstLog.IsVisible[node] := (nodeData^.Level in VisibleLevels);
+ end;
+ end;
+ finally
+ vstLog.EndUpdate;
+ end;
+ end;
+
PausedLogCount := 0;
UpdateStatus;
end;
diff --git a/X2Log.Observer.NamedPipe.pas b/X2Log.Observer.NamedPipe.pas
index ba8c2d5..0f76ca9 100644
--- a/X2Log.Observer.NamedPipe.pas
+++ b/X2Log.Observer.NamedPipe.pas
@@ -326,7 +326,9 @@ begin
eventHandles[Clients.Count] := LogQueueSignal.Handle;
waitResult := WaitForMultipleObjects(Length(eventHandles), @eventHandles[0], False, INFINITE);
- if waitResult in [WAIT_OBJECT_0..WAIT_OBJECT_0 + Pred(High(eventHandles))] then
+
+ { WAIT_OBJECT_0 = 0, no check for minimum bounds since it's an unsigned variable ("Comparison always results to true") }
+ if waitResult < Cardinal(WAIT_OBJECT_0 + High(eventHandles)) then
begin
{ Connect or write I/O completed }
clientIndex := waitResult - WAIT_OBJECT_0;
@@ -336,7 +338,7 @@ begin
begin
{ Entry queued }
break;
- end else if waitResult in [WAIT_ABANDONED_0..WAIT_ABANDONED_0 + High(eventHandles)] then
+ end else if (waitResult >= WAIT_ABANDONED_0) and (waitResult <= Cardinal(WAIT_ABANDONED_0 + High(eventHandles))) then
begin
{ Client event abandoned }
clientIndex := waitResult - WAIT_ABANDONED_0;