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;