GitHub-Mirror/x2log
1
0
Fork 0
mirror of synced 2024-12-11 20:13:08 +01:00
Code Issues Projects Releases Wiki Activity

Changed: named pipes are now prefixed with "X2Log.", to accomodate:

Browse Source 
Added: TX2LogNamedPipeClient.ActiveServers class function
Fixed: renamed madExceptHandler unit applied to test application
This commit is contained in:
Mark van Renswoude 2014-08-18 12:07:33 +00:00
parent 3b635b3454
commit 4efc4000ff
6 changed files with 235 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Test/X2LogTest.dpr
View File

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

2
Test/X2LogTest.dproj
View File

@ -179,7 +179,7 @@
<DCCReference Include="..\X2Log.Observer.Event.pas"/>
<DCCReference Include="..\X2Log.Observer.Custom.pas"/>
<DCCReference Include="..\X2Log.Exception.Default.pas"/>
<DCCReference Include="..\X2Log.Exception.madExcept.pas"/>
<DCCReference Include="..\X2Log.Exception.madExceptHandler.pas"/>
<DCCReference Include="..\X2Log.Observer.LogFile.pas"/>
<DCCReference Include="..\X2Log.Constants.pas"/>
<DCCReference Include="..\X2Log.Observer.NamedPipe.pas"/>

33
Test/source/MainFrm.dfm
View File

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

28
Test/source/MainFrm.pas
View File

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

174
X2Log.Client.NamedPipe.pas
View File

@ -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<TX2LogNamedPipeServerInfo>;
end;
implementation
uses
System.SyncObjs,
System.StrUtils,
System.SysUtils,
System.Types,
Winapi.Windows,
@ -69,8 +85,50 @@ type
end;
TX2LogNamedPipeServerInfoList = class(TInterfacedObject, IEnumerable<TX2LogNamedPipeServerInfo>, IEnumerable)
private
FServers: TList<TX2LogNamedPipeServerInfo>;
protected
{ IEnumerable }
function GetEnumerator: IEnumerator;
function IEnumerable<TX2LogNamedPipeServerInfo>.GetEnumerator = GetGenericEnumerator;
function GetGenericEnumerator: IEnumerator<TX2LogNamedPipeServerInfo>;
procedure EnumerateServers;
property Servers: TList<TX2LogNamedPipeServerInfo> read FServers;
public
constructor Create;
destructor Destroy; override;
end;
TX2LogNamedPipeServerInfoEnumerator = class(TInterfacedObject, IEnumerator<TX2LogNamedPipeServerInfo>, IEnumerator)
private
FList: TList<TX2LogNamedPipeServerInfo>;
FEnumerator: TEnumerator<TX2LogNamedPipeServerInfo>;
protected
{ IEnumerator }
function GetCurrent: TObject;
function MoveNext: Boolean;
procedure Reset;
function IEnumerator<TX2LogNamedPipeServerInfo>.GetCurrent = GetGenericCurrent;
function GetGenericCurrent: TX2LogNamedPipeServerInfo;
property List: TList<TX2LogNamedPipeServerInfo> read FList;
property Enumerator: TEnumerator<TX2LogNamedPipeServerInfo> read FEnumerator;
public
constructor Create(AList: TList<TX2LogNamedPipeServerInfo>);
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<TX2LogNamedPipeServerInfo>;
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<TX2LogNamedPipeServerInfo>.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<TX2LogNamedPipeServerInfo>;
begin
Result := TX2LogNamedPipeServerInfoEnumerator.Create(Servers);
end;
{ TX2LogNamedPipeServerInfoEnumerator }
constructor TX2LogNamedPipeServerInfoEnumerator.Create(AList: TList<TX2LogNamedPipeServerInfo>);
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.

5
X2Log.Observer.NamedPipe.pas
View File

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