GitHub-Mirror/x2log
1
0
Fork 0
mirror of synced 2024-11-24 11:43:07 +01:00
Code Issues Projects Releases Wiki Activity

Fixed: FS#20 - OutputDebugString still present in NamedPipeClient

Browse Source 
Fixed: FS#21 - NamedPipe observer fails to flush queue in time
This commit is contained in:
Mark van Renswoude 2014-10-22 18:24:54 +00:00
parent d7b18972c3
commit 31e9be16d3
6 changed files with 143 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Test/X2LogTest.dpr
View File

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

1
Test/X2LogTest.dproj
View File

@ -194,6 +194,7 @@
<DCCReference Include="..\X2Log.Details.Registry.pas"/>
<DCCReference Include="..\X2Log.Details.Intf.pas"/>
<DCCReference Include="..\X2Log.Util.Stream.pas"/>
<DCCReference Include="..\X2Log.Decorator.pas"/>
<RcItem Include="resources\Graphic.jpg">
<ResourceType>RCDATA</ResourceType>
<ResourceId>GraphicDetails</ResourceId>

117
Test/source/MainFrm.dfm
View File

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

38
Test/source/MainFrm.pas
View File

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

9
X2Log.Observer.CustomThreaded.pas
View File

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

2
X2Log.Observer.NamedPipe.pas
View File

@ -146,8 +146,6 @@ end;
procedure TX2LogNamedPipeClient.Send(AEntry: TX2LogQueueEntry);
begin
OutputDebugString(PChar(AEntry.Message));
if not Assigned(WriteBuffer) then
DoSend(AEntry)
else