diff --git a/Test/X2LogTest.dpr b/Test/X2LogTest.dpr index 769488a..0b9d6f2 100644 --- a/Test/X2LogTest.dpr +++ b/Test/X2LogTest.dpr @@ -22,7 +22,8 @@ uses X2Log.Details.Default in '..\X2Log.Details.Default.pas', X2Log.Details.Registry in '..\X2Log.Details.Registry.pas', X2Log.Details.Intf in '..\X2Log.Details.Intf.pas', - X2Log.Util.Stream in '..\X2Log.Util.Stream.pas'; + X2Log.Util.Stream in '..\X2Log.Util.Stream.pas', + X2Log.Decorator in '..\X2Log.Decorator.pas'; {$R *.res} diff --git a/Test/X2LogTest.dproj b/Test/X2LogTest.dproj index 1d6edc9..c66fb7e 100644 --- a/Test/X2LogTest.dproj +++ b/Test/X2LogTest.dproj @@ -194,6 +194,7 @@ + RCDATA GraphicDetails diff --git a/Test/source/MainFrm.dfm b/Test/source/MainFrm.dfm index 97fda3f..de36aee 100644 --- a/Test/source/MainFrm.dfm +++ b/Test/source/MainFrm.dfm @@ -3,7 +3,7 @@ object MainForm: TMainForm Top = 0 Caption = 'X'#178'Log Test' ClientHeight = 544 - ClientWidth = 611 + ClientWidth = 647 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText @@ -20,23 +20,25 @@ object MainForm: TMainForm AlignWithMargins = True Left = 8 Top = 176 - Width = 595 + Width = 631 Height = 327 Margins.Left = 8 Margins.Top = 8 Margins.Right = 8 Margins.Bottom = 8 - ActivePage = tsEvent + ActivePage = tsNamedPipe Align = alClient Images = ilsObservers TabOrder = 0 + ExplicitWidth = 595 object tsEvent: TTabSheet Caption = 'Event' + ExplicitWidth = 587 object mmoEvent: TMemo AlignWithMargins = True Left = 8 Top = 40 - Width = 571 + Width = 607 Height = 251 Margins.Left = 8 Margins.Top = 40 @@ -46,6 +48,7 @@ object MainForm: TMainForm ReadOnly = True ScrollBars = ssVertical TabOrder = 0 + ExplicitWidth = 571 end object btnEventStart: TButton Left = 8 @@ -68,6 +71,10 @@ object MainForm: TMainForm end object tsFile: TTabSheet Caption = 'File' + ExplicitWidth = 587 + DesignSize = ( + 623 + 299) object lblFilename: TLabel Left = 12 Top = 64 @@ -96,8 +103,9 @@ object MainForm: TMainForm object edtFilename: TEdit Left = 88 Top = 61 - Width = 489 + Width = 525 Height = 21 + Anchors = [akLeft, akTop, akRight] TabOrder = 2 Text = 'X2LogTest\Test.log' end @@ -130,8 +138,9 @@ object MainForm: TMainForm end object tsNamedPipe: TTabSheet Caption = 'Named Pipe' + ExplicitWidth = 587 DesignSize = ( - 587 + 623 299) object lblPipeName: TLabel Left = 8 @@ -168,13 +177,14 @@ object MainForm: TMainForm object edtPipeName: TEdit Left = 88 Top = 61 - Width = 489 + Width = 525 Height = 21 + Anchors = [akLeft, akTop, akRight] TabOrder = 2 Text = 'X2LogTest' end object btnNamedPipeRefresh: TButton - Left = 502 + Left = 538 Top = 96 Width = 75 Height = 25 @@ -182,15 +192,17 @@ object MainForm: TMainForm Caption = '&Refresh' TabOrder = 3 OnClick = btnNamedPipeRefreshClick + ExplicitLeft = 502 end object lbNamedPipeServers: TListBox Left = 8 Top = 132 - Width = 569 + Width = 605 Height = 157 Anchors = [akLeft, akTop, akRight, akBottom] ItemHeight = 13 TabOrder = 4 + ExplicitWidth = 569 end end end @@ -198,7 +210,7 @@ object MainForm: TMainForm AlignWithMargins = True Left = 8 Top = 511 - Width = 595 + Width = 631 Height = 25 Margins.Left = 8 Margins.Top = 0 @@ -207,8 +219,9 @@ object MainForm: TMainForm Align = alBottom BevelOuter = bvNone TabOrder = 1 + ExplicitWidth = 595 object btnClose: TButton - Left = 520 + Left = 556 Top = 0 Width = 75 Height = 25 @@ -217,6 +230,7 @@ object MainForm: TMainForm Caption = 'Close' TabOrder = 1 OnClick = btnCloseClick + ExplicitLeft = 520 end object btnMonitorForm: TButton Left = 0 @@ -266,19 +280,21 @@ object MainForm: TMainForm AlignWithMargins = True Left = 8 Top = 32 - Width = 595 + Width = 631 Height = 104 Margins.Left = 8 Margins.Top = 8 Margins.Right = 8 Margins.Bottom = 0 - ActivePage = tsBinary + ActivePage = tsTimer Align = alTop TabOrder = 2 + ExplicitWidth = 595 object tsText: TTabSheet Caption = 'Text' + ExplicitWidth = 587 DesignSize = ( - 587 + 623 76) object lblMessage: TLabel Left = 16 @@ -326,12 +342,13 @@ object MainForm: TMainForm object edtMessage: TEdit Left = 92 Top = 12 - Width = 477 + Width = 513 Height = 21 Anchors = [akLeft, akTop, akRight] TabOrder = 4 Text = 'Hello world!' OnKeyDown = edtMessageKeyDown + ExplicitWidth = 477 end object btnCategory: TButton Left = 416 @@ -346,8 +363,9 @@ object MainForm: TMainForm object tsException: TTabSheet Caption = 'Exception' ImageIndex = 1 + ExplicitWidth = 587 DesignSize = ( - 587 + 623 76) object lblException: TLabel Left = 16 @@ -368,17 +386,19 @@ object MainForm: TMainForm object edtException: TEdit Left = 92 Top = 12 - Width = 477 + Width = 513 Height = 21 Anchors = [akLeft, akTop, akRight] TabOrder = 1 Text = 'Horrible things are happening.' OnKeyDown = edtExceptionKeyDown + ExplicitWidth = 477 end end object tsBinary: TTabSheet Caption = 'Binary' ImageIndex = 2 + ExplicitWidth = 587 object btnBinaryRawByteString: TButton Left = 12 Top = 15 @@ -398,12 +418,60 @@ object MainForm: TMainForm OnClick = btnGraphicClick end end + object tsTimer: TTabSheet + Caption = 'Timer' + ImageIndex = 3 + ExplicitWidth = 587 + object lblTimer: TLabel + Left = 8 + Top = 12 + Width = 580 + Height = 13 + Caption = + 'Send out a series of log messages at regular intervals. Tests an' + + ' issue with the thread queue in the named pipe observer.' + end + object lblInterval: TLabel + Left = 8 + Top = 43 + Width = 92 + Height = 13 + Caption = 'Interval (seconds):' + end + object edtInterval: TEdit + Left = 130 + Top = 40 + Width = 89 + Height = 21 + TabOrder = 0 + Text = '1' + end + object btnTimerStart: TButton + Left = 228 + Top = 38 + Width = 75 + Height = 25 + Caption = 'Start' + TabOrder = 1 + OnClick = btnTimerStartClick + end + object btnTimerStop: TButton + Left = 309 + Top = 38 + Width = 75 + Height = 25 + Caption = 'Stop' + Enabled = False + TabOrder = 2 + OnClick = btnTimerStopClick + end + end end object pnlDispatch: TPanel AlignWithMargins = True Left = 8 Top = 0 - Width = 595 + Width = 631 Height = 24 Margins.Left = 8 Margins.Top = 0 @@ -420,6 +488,7 @@ object MainForm: TMainForm Font.Style = [fsBold] ParentFont = False TabOrder = 3 + ExplicitWidth = 595 object bvlDispatch: TBevel Left = 80 Top = 12 @@ -432,7 +501,7 @@ object MainForm: TMainForm AlignWithMargins = True Left = 8 Top = 144 - Width = 595 + Width = 631 Height = 24 Margins.Left = 8 Margins.Top = 8 @@ -449,6 +518,7 @@ object MainForm: TMainForm Font.Style = [fsBold] ParentFont = False TabOrder = 4 + ExplicitWidth = 595 object bvlObservers: TBevel Left = 80 Top = 12 @@ -463,7 +533,7 @@ object MainForm: TMainForm Left = 552 Top = 176 Bitmap = { - 494C01010200140050000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 + 494C01010200140054000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 0000000000003600000028000000300000000C00000001002000000000000009 0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -545,4 +615,11 @@ object MainForm: TMainForm E07E070000000000FFFFFF000000000000000000000000000000000000000000 000000000000} end + object Timer: TTimer + Enabled = False + Interval = 10000 + OnTimer = TimerTimer + Left = 464 + Top = 176 + end end diff --git a/Test/source/MainFrm.pas b/Test/source/MainFrm.pas index a9a2376..47ac3c8 100644 --- a/Test/source/MainFrm.pas +++ b/Test/source/MainFrm.pas @@ -62,6 +62,13 @@ type btnLock: TButton; btnUnlock: TButton; btnCategory: TButton; + tsTimer: TTabSheet; + lblTimer: TLabel; + lblInterval: TLabel; + edtInterval: TEdit; + btnTimerStart: TButton; + btnTimerStop: TButton; + Timer: TTimer; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); @@ -83,6 +90,9 @@ type procedure btnGraphicClick(Sender: TObject); procedure btnNamedPipeRefreshClick(Sender: TObject); procedure btnCategoryClick(Sender: TObject); + procedure btnTimerStartClick(Sender: TObject); + procedure btnTimerStopClick(Sender: TObject); + procedure TimerTimer(Sender: TObject); private FLog: IX2Log; FEventObserver: IX2LogObserver; @@ -364,4 +374,32 @@ begin end; end; + +procedure TMainForm.btnTimerStartClick(Sender: TObject); +begin + Timer.Interval := StrToIntDef(edtInterval.Text, 5) * 1000; + Timer.Enabled := True; + + btnTimerStart.Enabled := False; + btnTimerStop.Enabled := True; +end; + + +procedure TMainForm.btnTimerStopClick(Sender: TObject); +begin + Timer.Enabled := False; + + btnTimerStart.Enabled := True; + btnTimerStop.Enabled := False; +end; + + +procedure TMainForm.TimerTimer(Sender: TObject); +begin + FLog.Warning('Batch start'); + FLog.Info('Message 1'); + FLog.Info('Message 2'); + FLog.Info('Message 3'); +end; + end. diff --git a/X2Log.Observer.CustomThreaded.pas b/X2Log.Observer.CustomThreaded.pas index fa68a07..7585572 100644 --- a/X2Log.Observer.CustomThreaded.pas +++ b/X2Log.Observer.CustomThreaded.pas @@ -150,7 +150,7 @@ end; constructor TX2LogObserverWorkerThread.Create; begin FThreadStartSignal := TEvent.Create(nil, True, False, ''); - FLogQueueSignal := TEvent.Create(nil, False, False, ''); + FLogQueueSignal := TEvent.Create(nil, True, False, ''); FLogQueue := TObjectQueue.Create(True); inherited Create(False); @@ -177,11 +177,10 @@ begin TMonitor.Enter(LogQueue); try LogQueue.Enqueue(TX2LogQueueEntry.Create(ALevel, ADateTime, AMessage, ACategory, ADetails)); + LogQueueSignal.SetEvent; finally TMonitor.Exit(LogQueue); end; - - LogQueueSignal.SetEvent; end; @@ -205,7 +204,9 @@ begin TMonitor.Enter(LogQueue); try if LogQueue.Count > 0 then - entry := LogQueue.Extract; + entry := LogQueue.Extract + else + LogQueueSignal.ResetEvent; finally TMonitor.Exit(LogQueue); end; diff --git a/X2Log.Observer.NamedPipe.pas b/X2Log.Observer.NamedPipe.pas index d19c4a8..df8ff9e 100644 --- a/X2Log.Observer.NamedPipe.pas +++ b/X2Log.Observer.NamedPipe.pas @@ -146,8 +146,6 @@ end; procedure TX2LogNamedPipeClient.Send(AEntry: TX2LogQueueEntry); begin - OutputDebugString(PChar(AEntry.Message)); - if not Assigned(WriteBuffer) then DoSend(AEntry) else