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