1
0
mirror of synced 2024-11-24 19:53:08 +01:00

Fixed: FS#20 - OutputDebugString still present in NamedPipeClient

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

View File

@ -22,7 +22,8 @@ uses
X2Log.Details.Default in '..\X2Log.Details.Default.pas', X2Log.Details.Default in '..\X2Log.Details.Default.pas',
X2Log.Details.Registry in '..\X2Log.Details.Registry.pas', X2Log.Details.Registry in '..\X2Log.Details.Registry.pas',
X2Log.Details.Intf in '..\X2Log.Details.Intf.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} {$R *.res}

View File

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

View File

@ -3,7 +3,7 @@ object MainForm: TMainForm
Top = 0 Top = 0
Caption = 'X'#178'Log Test' Caption = 'X'#178'Log Test'
ClientHeight = 544 ClientHeight = 544
ClientWidth = 611 ClientWidth = 647
Color = clBtnFace Color = clBtnFace
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
@ -20,23 +20,25 @@ object MainForm: TMainForm
AlignWithMargins = True AlignWithMargins = True
Left = 8 Left = 8
Top = 176 Top = 176
Width = 595 Width = 631
Height = 327 Height = 327
Margins.Left = 8 Margins.Left = 8
Margins.Top = 8 Margins.Top = 8
Margins.Right = 8 Margins.Right = 8
Margins.Bottom = 8 Margins.Bottom = 8
ActivePage = tsEvent ActivePage = tsNamedPipe
Align = alClient Align = alClient
Images = ilsObservers Images = ilsObservers
TabOrder = 0 TabOrder = 0
ExplicitWidth = 595
object tsEvent: TTabSheet object tsEvent: TTabSheet
Caption = 'Event' Caption = 'Event'
ExplicitWidth = 587
object mmoEvent: TMemo object mmoEvent: TMemo
AlignWithMargins = True AlignWithMargins = True
Left = 8 Left = 8
Top = 40 Top = 40
Width = 571 Width = 607
Height = 251 Height = 251
Margins.Left = 8 Margins.Left = 8
Margins.Top = 40 Margins.Top = 40
@ -46,6 +48,7 @@ object MainForm: TMainForm
ReadOnly = True ReadOnly = True
ScrollBars = ssVertical ScrollBars = ssVertical
TabOrder = 0 TabOrder = 0
ExplicitWidth = 571
end end
object btnEventStart: TButton object btnEventStart: TButton
Left = 8 Left = 8
@ -68,6 +71,10 @@ object MainForm: TMainForm
end end
object tsFile: TTabSheet object tsFile: TTabSheet
Caption = 'File' Caption = 'File'
ExplicitWidth = 587
DesignSize = (
623
299)
object lblFilename: TLabel object lblFilename: TLabel
Left = 12 Left = 12
Top = 64 Top = 64
@ -96,8 +103,9 @@ object MainForm: TMainForm
object edtFilename: TEdit object edtFilename: TEdit
Left = 88 Left = 88
Top = 61 Top = 61
Width = 489 Width = 525
Height = 21 Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 2 TabOrder = 2
Text = 'X2LogTest\Test.log' Text = 'X2LogTest\Test.log'
end end
@ -130,8 +138,9 @@ object MainForm: TMainForm
end end
object tsNamedPipe: TTabSheet object tsNamedPipe: TTabSheet
Caption = 'Named Pipe' Caption = 'Named Pipe'
ExplicitWidth = 587
DesignSize = ( DesignSize = (
587 623
299) 299)
object lblPipeName: TLabel object lblPipeName: TLabel
Left = 8 Left = 8
@ -168,13 +177,14 @@ object MainForm: TMainForm
object edtPipeName: TEdit object edtPipeName: TEdit
Left = 88 Left = 88
Top = 61 Top = 61
Width = 489 Width = 525
Height = 21 Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 2 TabOrder = 2
Text = 'X2LogTest' Text = 'X2LogTest'
end end
object btnNamedPipeRefresh: TButton object btnNamedPipeRefresh: TButton
Left = 502 Left = 538
Top = 96 Top = 96
Width = 75 Width = 75
Height = 25 Height = 25
@ -182,15 +192,17 @@ object MainForm: TMainForm
Caption = '&Refresh' Caption = '&Refresh'
TabOrder = 3 TabOrder = 3
OnClick = btnNamedPipeRefreshClick OnClick = btnNamedPipeRefreshClick
ExplicitLeft = 502
end end
object lbNamedPipeServers: TListBox object lbNamedPipeServers: TListBox
Left = 8 Left = 8
Top = 132 Top = 132
Width = 569 Width = 605
Height = 157 Height = 157
Anchors = [akLeft, akTop, akRight, akBottom] Anchors = [akLeft, akTop, akRight, akBottom]
ItemHeight = 13 ItemHeight = 13
TabOrder = 4 TabOrder = 4
ExplicitWidth = 569
end end
end end
end end
@ -198,7 +210,7 @@ object MainForm: TMainForm
AlignWithMargins = True AlignWithMargins = True
Left = 8 Left = 8
Top = 511 Top = 511
Width = 595 Width = 631
Height = 25 Height = 25
Margins.Left = 8 Margins.Left = 8
Margins.Top = 0 Margins.Top = 0
@ -207,8 +219,9 @@ object MainForm: TMainForm
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 1 TabOrder = 1
ExplicitWidth = 595
object btnClose: TButton object btnClose: TButton
Left = 520 Left = 556
Top = 0 Top = 0
Width = 75 Width = 75
Height = 25 Height = 25
@ -217,6 +230,7 @@ object MainForm: TMainForm
Caption = 'Close' Caption = 'Close'
TabOrder = 1 TabOrder = 1
OnClick = btnCloseClick OnClick = btnCloseClick
ExplicitLeft = 520
end end
object btnMonitorForm: TButton object btnMonitorForm: TButton
Left = 0 Left = 0
@ -266,19 +280,21 @@ object MainForm: TMainForm
AlignWithMargins = True AlignWithMargins = True
Left = 8 Left = 8
Top = 32 Top = 32
Width = 595 Width = 631
Height = 104 Height = 104
Margins.Left = 8 Margins.Left = 8
Margins.Top = 8 Margins.Top = 8
Margins.Right = 8 Margins.Right = 8
Margins.Bottom = 0 Margins.Bottom = 0
ActivePage = tsBinary ActivePage = tsTimer
Align = alTop Align = alTop
TabOrder = 2 TabOrder = 2
ExplicitWidth = 595
object tsText: TTabSheet object tsText: TTabSheet
Caption = 'Text' Caption = 'Text'
ExplicitWidth = 587
DesignSize = ( DesignSize = (
587 623
76) 76)
object lblMessage: TLabel object lblMessage: TLabel
Left = 16 Left = 16
@ -326,12 +342,13 @@ object MainForm: TMainForm
object edtMessage: TEdit object edtMessage: TEdit
Left = 92 Left = 92
Top = 12 Top = 12
Width = 477 Width = 513
Height = 21 Height = 21
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
TabOrder = 4 TabOrder = 4
Text = 'Hello world!' Text = 'Hello world!'
OnKeyDown = edtMessageKeyDown OnKeyDown = edtMessageKeyDown
ExplicitWidth = 477
end end
object btnCategory: TButton object btnCategory: TButton
Left = 416 Left = 416
@ -346,8 +363,9 @@ object MainForm: TMainForm
object tsException: TTabSheet object tsException: TTabSheet
Caption = 'Exception' Caption = 'Exception'
ImageIndex = 1 ImageIndex = 1
ExplicitWidth = 587
DesignSize = ( DesignSize = (
587 623
76) 76)
object lblException: TLabel object lblException: TLabel
Left = 16 Left = 16
@ -368,17 +386,19 @@ object MainForm: TMainForm
object edtException: TEdit object edtException: TEdit
Left = 92 Left = 92
Top = 12 Top = 12
Width = 477 Width = 513
Height = 21 Height = 21
Anchors = [akLeft, akTop, akRight] Anchors = [akLeft, akTop, akRight]
TabOrder = 1 TabOrder = 1
Text = 'Horrible things are happening.' Text = 'Horrible things are happening.'
OnKeyDown = edtExceptionKeyDown OnKeyDown = edtExceptionKeyDown
ExplicitWidth = 477
end end
end end
object tsBinary: TTabSheet object tsBinary: TTabSheet
Caption = 'Binary' Caption = 'Binary'
ImageIndex = 2 ImageIndex = 2
ExplicitWidth = 587
object btnBinaryRawByteString: TButton object btnBinaryRawByteString: TButton
Left = 12 Left = 12
Top = 15 Top = 15
@ -398,12 +418,60 @@ object MainForm: TMainForm
OnClick = btnGraphicClick OnClick = btnGraphicClick
end end
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 end
object pnlDispatch: TPanel object pnlDispatch: TPanel
AlignWithMargins = True AlignWithMargins = True
Left = 8 Left = 8
Top = 0 Top = 0
Width = 595 Width = 631
Height = 24 Height = 24
Margins.Left = 8 Margins.Left = 8
Margins.Top = 0 Margins.Top = 0
@ -420,6 +488,7 @@ object MainForm: TMainForm
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
TabOrder = 3 TabOrder = 3
ExplicitWidth = 595
object bvlDispatch: TBevel object bvlDispatch: TBevel
Left = 80 Left = 80
Top = 12 Top = 12
@ -432,7 +501,7 @@ object MainForm: TMainForm
AlignWithMargins = True AlignWithMargins = True
Left = 8 Left = 8
Top = 144 Top = 144
Width = 595 Width = 631
Height = 24 Height = 24
Margins.Left = 8 Margins.Left = 8
Margins.Top = 8 Margins.Top = 8
@ -449,6 +518,7 @@ object MainForm: TMainForm
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
TabOrder = 4 TabOrder = 4
ExplicitWidth = 595
object bvlObservers: TBevel object bvlObservers: TBevel
Left = 80 Left = 80
Top = 12 Top = 12
@ -463,7 +533,7 @@ object MainForm: TMainForm
Left = 552 Left = 552
Top = 176 Top = 176
Bitmap = { Bitmap = {
494C01010200140050000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 494C01010200140054000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000300000000C00000001002000000000000009 0000000000003600000028000000300000000C00000001002000000000000009
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000
@ -545,4 +615,11 @@ object MainForm: TMainForm
E07E070000000000FFFFFF000000000000000000000000000000000000000000 E07E070000000000FFFFFF000000000000000000000000000000000000000000
000000000000} 000000000000}
end end
object Timer: TTimer
Enabled = False
Interval = 10000
OnTimer = TimerTimer
Left = 464
Top = 176
end
end end

View File

@ -62,6 +62,13 @@ type
btnLock: TButton; btnLock: TButton;
btnUnlock: TButton; btnUnlock: TButton;
btnCategory: TButton; btnCategory: TButton;
tsTimer: TTabSheet;
lblTimer: TLabel;
lblInterval: TLabel;
edtInterval: TEdit;
btnTimerStart: TButton;
btnTimerStop: TButton;
Timer: TTimer;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
@ -83,6 +90,9 @@ type
procedure btnGraphicClick(Sender: TObject); procedure btnGraphicClick(Sender: TObject);
procedure btnNamedPipeRefreshClick(Sender: TObject); procedure btnNamedPipeRefreshClick(Sender: TObject);
procedure btnCategoryClick(Sender: TObject); procedure btnCategoryClick(Sender: TObject);
procedure btnTimerStartClick(Sender: TObject);
procedure btnTimerStopClick(Sender: TObject);
procedure TimerTimer(Sender: TObject);
private private
FLog: IX2Log; FLog: IX2Log;
FEventObserver: IX2LogObserver; FEventObserver: IX2LogObserver;
@ -364,4 +374,32 @@ begin
end; end;
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. end.

View File

@ -150,7 +150,7 @@ end;
constructor TX2LogObserverWorkerThread.Create; constructor TX2LogObserverWorkerThread.Create;
begin begin
FThreadStartSignal := TEvent.Create(nil, True, False, ''); FThreadStartSignal := TEvent.Create(nil, True, False, '');
FLogQueueSignal := TEvent.Create(nil, False, False, ''); FLogQueueSignal := TEvent.Create(nil, True, False, '');
FLogQueue := TObjectQueue<TX2LogQueueEntry>.Create(True); FLogQueue := TObjectQueue<TX2LogQueueEntry>.Create(True);
inherited Create(False); inherited Create(False);
@ -177,11 +177,10 @@ begin
TMonitor.Enter(LogQueue); TMonitor.Enter(LogQueue);
try try
LogQueue.Enqueue(TX2LogQueueEntry.Create(ALevel, ADateTime, AMessage, ACategory, ADetails)); LogQueue.Enqueue(TX2LogQueueEntry.Create(ALevel, ADateTime, AMessage, ACategory, ADetails));
LogQueueSignal.SetEvent;
finally finally
TMonitor.Exit(LogQueue); TMonitor.Exit(LogQueue);
end; end;
LogQueueSignal.SetEvent;
end; end;
@ -205,7 +204,9 @@ begin
TMonitor.Enter(LogQueue); TMonitor.Enter(LogQueue);
try try
if LogQueue.Count > 0 then if LogQueue.Count > 0 then
entry := LogQueue.Extract; entry := LogQueue.Extract
else
LogQueueSignal.ResetEvent;
finally finally
TMonitor.Exit(LogQueue); TMonitor.Exit(LogQueue);
end; end;

View File

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