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