From 4efc4000ff00d77a00b0aab32bce49bf06f678d1 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Mon, 18 Aug 2014 12:07:33 +0000 Subject: [PATCH] Changed: named pipes are now prefixed with "X2Log.", to accomodate: Added: TX2LogNamedPipeClient.ActiveServers class function Fixed: renamed madExceptHandler unit applied to test application --- Test/X2LogTest.dpr | 2 +- Test/X2LogTest.dproj | 2 +- Test/source/MainFrm.dfm | 33 ++++++- Test/source/MainFrm.pas | 28 +++++- X2Log.Client.NamedPipe.pas | 174 ++++++++++++++++++++++++++++++++++- X2Log.Observer.NamedPipe.pas | 5 +- 6 files changed, 235 insertions(+), 9 deletions(-) diff --git a/Test/X2LogTest.dpr b/Test/X2LogTest.dpr index 7c82113..769488a 100644 --- a/Test/X2LogTest.dpr +++ b/Test/X2LogTest.dpr @@ -10,7 +10,7 @@ uses X2Log.Observer.Event in '..\X2Log.Observer.Event.pas', X2Log.Observer.Custom in '..\X2Log.Observer.Custom.pas', X2Log.Exception.Default in '..\X2Log.Exception.Default.pas', - X2Log.Exception.madExcept in '..\X2Log.Exception.madExcept.pas', + X2Log.Exception.madExceptHandler in '..\X2Log.Exception.madExceptHandler.pas', X2Log.Observer.LogFile in '..\X2Log.Observer.LogFile.pas', X2Log.Constants in '..\X2Log.Constants.pas', X2Log.Observer.NamedPipe in '..\X2Log.Observer.NamedPipe.pas', diff --git a/Test/X2LogTest.dproj b/Test/X2LogTest.dproj index abc09a7..1d6edc9 100644 --- a/Test/X2LogTest.dproj +++ b/Test/X2LogTest.dproj @@ -179,7 +179,7 @@ - + diff --git a/Test/source/MainFrm.dfm b/Test/source/MainFrm.dfm index 330e329..93c5c88 100644 --- a/Test/source/MainFrm.dfm +++ b/Test/source/MainFrm.dfm @@ -130,13 +130,25 @@ object MainForm: TMainForm end object tsNamedPipe: TTabSheet Caption = 'Named Pipe' + ExplicitLeft = 16 + ExplicitTop = 33 + DesignSize = ( + 587 + 299) object lblPipeName: TLabel - Left = 12 + Left = 8 Top = 64 Width = 53 Height = 13 Caption = 'Pipe name:' end + object lblNamedPipeServers: TLabel + Left = 8 + Top = 108 + Width = 73 + Height = 13 + Caption = 'Active servers:' + end object btnNamedPipeStart: TButton Left = 8 Top = 8 @@ -163,6 +175,25 @@ object MainForm: TMainForm TabOrder = 2 Text = 'X2LogTest' end + object btnNamedPipeRefresh: TButton + Left = 502 + Top = 96 + Width = 75 + Height = 25 + Anchors = [akTop, akRight] + Caption = '&Refresh' + TabOrder = 3 + OnClick = btnNamedPipeRefreshClick + end + object lbNamedPipeServers: TListBox + Left = 8 + Top = 132 + Width = 569 + Height = 157 + Anchors = [akLeft, akTop, akRight, akBottom] + ItemHeight = 13 + TabOrder = 4 + end end end object pnlButtons: TPanel diff --git a/Test/source/MainFrm.pas b/Test/source/MainFrm.pas index 5a85870..37f521f 100644 --- a/Test/source/MainFrm.pas +++ b/Test/source/MainFrm.pas @@ -7,9 +7,10 @@ uses Vcl.Controls, Vcl.ExtCtrls, Vcl.Forms, + Vcl.ImgList, Vcl.StdCtrls, - X2Log.Intf, Vcl.ImgList; + X2Log.Intf; type @@ -55,6 +56,9 @@ type pnlObservers: TPanel; bvlObservers: TBevel; btnGraphic: TButton; + lblNamedPipeServers: TLabel; + btnNamedPipeRefresh: TButton; + lbNamedPipeServers: TListBox; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); @@ -72,6 +76,7 @@ type procedure btnNamedPipeStopClick(Sender: TObject); procedure btnBinaryRawByteStringClick(Sender: TObject); procedure btnGraphicClick(Sender: TObject); + procedure btnNamedPipeRefreshClick(Sender: TObject); private FLog: IX2Log; FEventObserver: IX2LogObserver; @@ -89,10 +94,11 @@ uses Winapi.Windows, X2Log, + X2Log.Client.NamedPipe, X2Log.Constants, X2Log.Details.Default, X2Log.Details.Intf, - X2Log.Exception.madExcept, + X2Log.Exception.madExceptHandler, X2Log.Observer.Event, X2Log.Observer.LogFile, X2Log.Observer.MonitorForm, @@ -314,4 +320,22 @@ begin end; end; + + +procedure TMainForm.btnNamedPipeRefreshClick(Sender: TObject); +var + server: TX2LogNamedPipeServerInfo; + +begin + lbNamedPipeServers.Items.BeginUpdate; + try + lbNamedPipeServers.Items.Clear; + + for server in TX2LogNamedPipeClient.ActiveServers do + lbNamedPipeServers.Items.Add(server.DisplayName + ' (' + server.PipeName + ')'); + finally + lbNamedPipeServers.Items.EndUpdate; + end; +end; + end. diff --git a/X2Log.Client.NamedPipe.pas b/X2Log.Client.NamedPipe.pas index 3781cc0..0ffa7dc 100644 --- a/X2Log.Client.NamedPipe.pas +++ b/X2Log.Client.NamedPipe.pas @@ -10,6 +10,18 @@ uses type + TX2LogNamedPipeServerInfo = class(TObject) + private + FDisplayName: string; + FPipeName: string; + public + constructor Create(const APipeName: string); + + property DisplayName: string read FDisplayName; + property PipeName: string read FPipeName; + end; + + TX2LogNamedPipeClient = class(TX2LogBaseClient, IX2LogBase) private FWorkerThread: TThread; @@ -18,12 +30,16 @@ type public constructor Create(const APipeName: string); destructor Destroy; override; + + class function ActiveServers: IEnumerable; end; + implementation uses System.SyncObjs, + System.StrUtils, System.SysUtils, System.Types, Winapi.Windows, @@ -69,8 +85,50 @@ type end; + TX2LogNamedPipeServerInfoList = class(TInterfacedObject, IEnumerable, IEnumerable) + private + FServers: TList; + protected + { IEnumerable } + function GetEnumerator: IEnumerator; + + function IEnumerable.GetEnumerator = GetGenericEnumerator; + function GetGenericEnumerator: IEnumerator; + + procedure EnumerateServers; + + property Servers: TList read FServers; + public + constructor Create; + destructor Destroy; override; + end; + + + TX2LogNamedPipeServerInfoEnumerator = class(TInterfacedObject, IEnumerator, IEnumerator) + private + FList: TList; + FEnumerator: TEnumerator; + protected + { IEnumerator } + function GetCurrent: TObject; + function MoveNext: Boolean; + procedure Reset; + + function IEnumerator.GetCurrent = GetGenericCurrent; + function GetGenericCurrent: TX2LogNamedPipeServerInfo; + + property List: TList read FList; + property Enumerator: TEnumerator read FEnumerator; + public + constructor Create(AList: TList); + destructor Destroy; override; + end; + + + const - PipeNamePrefix = '\\.\pipe\'; + PipePrefix = '\\.\pipe\'; + PipeNamePrefix = 'X2Log.'; TimeoutBusyPipe = 5000; TimeoutNoPipe = 1000; @@ -95,6 +153,12 @@ begin end; +class function TX2LogNamedPipeClient.ActiveServers: IEnumerable; +begin + Result := TX2LogNamedPipeServerInfoList.Create; +end; + + { TX2LogNamedPipeClientWorkerThread } constructor TX2LogNamedPipeClientWorkerThread.Create(AClient: TX2LogNamedPipeClient; const APipeName: string); begin @@ -152,7 +216,7 @@ var begin while not Terminated do begin - FPipeHandle := CreateFile(PChar(PipeNamePrefix + PipeName), GENERIC_READ or FILE_WRITE_ATTRIBUTES, + FPipeHandle := CreateFile(PChar(PipePrefix + PipeNamePrefix + PipeName), GENERIC_READ or FILE_WRITE_ATTRIBUTES, 0, nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0); if PipeHandle = INVALID_HANDLE_VALUE then @@ -162,7 +226,7 @@ begin case lastError of ERROR_PIPE_BUSY: { Pipe exists but is connecting to another client, wait for a new slot } - WaitNamedPipe(PChar(PipeNamePrefix + PipeName), TimeoutBusyPipe); + WaitNamedPipe(PChar(PipePrefix + PipeNamePrefix + PipeName), TimeoutBusyPipe); ERROR_FILE_NOT_FOUND: { Pipe does not exist, try again later } @@ -345,4 +409,108 @@ begin end; end; + +{ TX2LogNamedPipeServerInfoList } +constructor TX2LogNamedPipeServerInfoList.Create; +begin + inherited Create; + + FServers := TObjectList.Create(True); + EnumerateServers; +end; + + +destructor TX2LogNamedPipeServerInfoList.Destroy; +begin + FreeAndNil(FServers); + + inherited Destroy; +end; + + +procedure TX2LogNamedPipeServerInfoList.EnumerateServers; +var + searchRec: TSearchRec; + +begin + if System.SysUtils.FindFirst(PipePrefix + '*', faAnyFile, searchRec) = 0 then + try + repeat + if StartsText(PipeNamePrefix, searchRec.Name) then + Servers.Add(TX2LogNamedPipeServerInfo.Create(searchRec.Name)); + until System.SysUtils.FindNext(searchRec) <> 0; + finally + System.SysUtils.FindClose(searchRec); + end; +end; + + +function TX2LogNamedPipeServerInfoList.GetEnumerator: IEnumerator; +begin + Result := GetGenericEnumerator; +end; + + +function TX2LogNamedPipeServerInfoList.GetGenericEnumerator: IEnumerator; +begin + Result := TX2LogNamedPipeServerInfoEnumerator.Create(Servers); +end; + + +{ TX2LogNamedPipeServerInfoEnumerator } +constructor TX2LogNamedPipeServerInfoEnumerator.Create(AList: TList); +begin + inherited Create; + + FList := AList; + Reset; +end; + + +destructor TX2LogNamedPipeServerInfoEnumerator.Destroy; +begin + FreeAndNil(FEnumerator); + + inherited Destroy; +end; + + +function TX2LogNamedPipeServerInfoEnumerator.GetCurrent: TObject; +begin + Result := GetGenericCurrent; +end; + + +function TX2LogNamedPipeServerInfoEnumerator.MoveNext: Boolean; +begin + Result := Enumerator.MoveNext; +end; + + +procedure TX2LogNamedPipeServerInfoEnumerator.Reset; +begin + FreeAndNil(FEnumerator); + FEnumerator := List.GetEnumerator; +end; + + +function TX2LogNamedPipeServerInfoEnumerator.GetGenericCurrent: TX2LogNamedPipeServerInfo; +begin + Result := Enumerator.Current; +end; + + +{ TX2LogNamedPipeServerInfo } +constructor TX2LogNamedPipeServerInfo.Create(const APipeName: string); +begin + inherited Create; + + FPipeName := APipeName; + + if StartsText(PipeNamePrefix, APipeName) then + FDisplayName := Copy(APipeName, Succ(Length(PipeNamePrefix)), MaxInt) + else + FDisplayName := APipeName; +end; + end. diff --git a/X2Log.Observer.NamedPipe.pas b/X2Log.Observer.NamedPipe.pas index 045a8c2..ba8c2d5 100644 --- a/X2Log.Observer.NamedPipe.pas +++ b/X2Log.Observer.NamedPipe.pas @@ -101,6 +101,9 @@ const SDDL_REVISION_1 = 1; + PipeNamePrefix = '\\.\pipe\X2Log.'; + + { TX2LogNamedPipeObserver } constructor TX2LogNamedPipeObserver.Create(const APipeName: string; ALogLevels: TX2LogLevels); @@ -442,7 +445,7 @@ begin nil) then begin try - pipe := CreateNamedPipe(PChar('\\.\pipe\' + PipeName), PIPE_ACCESS_OUTBOUND or FILE_FLAG_OVERLAPPED, + pipe := CreateNamedPipe(PChar(PipeNamePrefix + PipeName), PIPE_ACCESS_OUTBOUND or FILE_FLAG_OVERLAPPED, PIPE_TYPE_MESSAGE or PIPE_READMODE_MESSAGE or PIPE_WAIT, PIPE_UNLIMITED_INSTANCES, BufferSize, BufferSize, DefaultTimeout, @security); finally