diff --git a/NamedPipeClient/X2LogNamedPipeClient.dpr b/NamedPipeClient/X2LogNamedPipeClient.dpr
index b8066a3..3247b8b 100644
--- a/NamedPipeClient/X2LogNamedPipeClient.dpr
+++ b/NamedPipeClient/X2LogNamedPipeClient.dpr
@@ -2,13 +2,7 @@ program X2LogNamedPipeClient;
uses
Vcl.Forms,
- MainFrm in 'source\MainFrm.pas' {MainForm},
- X2Log.Intf in '..\X2Log.Intf.pas',
- X2Log.Client.NamedPipe in '..\X2Log.Client.NamedPipe.pas',
- X2Log.Client.Base in '..\X2Log.Client.Base.pas',
- X2Log.Observer.Event in '..\X2Log.Observer.Event.pas',
- X2Log.Constants in '..\X2Log.Constants.pas',
- X2Log.Observer.Custom in '..\X2Log.Observer.Custom.pas';
+ MainFrm in 'source\MainFrm.pas' {MainForm};
{$R *.res}
diff --git a/NamedPipeClient/X2LogNamedPipeClient.dproj b/NamedPipeClient/X2LogNamedPipeClient.dproj
index 0ee8f08..31e113e 100644
--- a/NamedPipeClient/X2LogNamedPipeClient.dproj
+++ b/NamedPipeClient/X2LogNamedPipeClient.dproj
@@ -40,6 +40,7 @@
true
+ ..\;$(DCC_UnitSearchPath)
fmx;IndySystem;DBXInterBaseDriver;DataSnapClient;DataSnapCommon;DataSnapServer;DataSnapProviderClient;DbxCommonDriver;dbxcds;DBXOracleDriver;CustomIPTransport;dsnap;fmxase;IndyCore;inetdbxpress;IPIndyImpl;bindcompfmx;rtl;dbrtl;DbxClientDriver;bindcomp;inetdb;xmlrtl;ibxpress;IndyProtocols;DBXMySQLDriver;soaprtl;bindengine;DBXInformixDriver;DBXFirebirdDriver;inet;fmxobj;DBXSybaseASADriver;fmxdae;dbexpress;DataSnapIndy10ServerTransport;$(DCC_UsePackage)
$(BDS)\bin\delphi_PROJECTICON.ico
System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)
@@ -68,6 +69,7 @@
true
+ $(BDS)\bin\default_app.manifest
true
1033
false
@@ -86,12 +88,6 @@
dfm
-
-
-
-
-
-
Cfg_2
Base
diff --git a/NamedPipeClient/source/MainFrm.pas b/NamedPipeClient/source/MainFrm.pas
index a1d80d0..6c7e2aa 100644
--- a/NamedPipeClient/source/MainFrm.pas
+++ b/NamedPipeClient/source/MainFrm.pas
@@ -25,6 +25,8 @@ type
implementation
uses
+ System.SysUtils,
+
X2Log.Constants,
X2Log.Client.NamedPipe,
X2Log.Observer.Event;
@@ -44,7 +46,7 @@ end;
procedure TMainForm.DoLog(Sender: TObject; Level: TX2LogLevel; const Msg, Details: string);
begin
- mmoLog.Lines.Add(GetLogLevelText(Level) + ': ' + Msg + ' (' + Details + ')');
+ mmoLog.Lines.Add(DateTimeToStr(Now) + ' ' + GetLogLevelText(Level) + ': ' + Msg + ' (' + Details + ')');
end;
end.
diff --git a/ServiceTest/X2LogServiceTest.dpr b/ServiceTest/X2LogServiceTest.dpr
new file mode 100644
index 0000000..bf88221
--- /dev/null
+++ b/ServiceTest/X2LogServiceTest.dpr
@@ -0,0 +1,16 @@
+program X2LogServiceTest;
+
+uses
+ Vcl.SvcMgr,
+ ServiceDMU in 'source\ServiceDMU.pas' {ServiceDM: TService};
+
+{$R *.RES}
+
+
+begin
+ if not Application.DelayInitialize or Application.Installing then
+ Application.Initialize;
+
+ Application.CreateForm(TServiceDM, ServiceDM);
+ Application.Run;
+end.
diff --git a/ServiceTest/X2LogServiceTest.dproj b/ServiceTest/X2LogServiceTest.dproj
new file mode 100644
index 0000000..c02057a
--- /dev/null
+++ b/ServiceTest/X2LogServiceTest.dproj
@@ -0,0 +1,179 @@
+
+
+ {F55F63BD-FBEE-4080-B6D6-0410C2731C0F}
+ 13.4
+ VCL
+ X2LogServiceTest.dpr
+ True
+ Debug
+ Win32
+ 1
+ Application
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Base
+ true
+
+
+ ..\;$(DCC_UnitSearchPath)
+ fmx;IndySystem;DBXInterBaseDriver;DataSnapClient;DataSnapCommon;DataSnapServer;DataSnapProviderClient;DbxCommonDriver;dbxcds;DBXOracleDriver;CustomIPTransport;dsnap;fmxase;IndyCore;inetdbxpress;IPIndyImpl;bindcompfmx;rtl;dbrtl;DbxClientDriver;bindcomp;inetdb;xmlrtl;ibxpress;IndyProtocols;DBXMySQLDriver;soaprtl;bindengine;DBXInformixDriver;DBXFirebirdDriver;inet;fmxobj;DBXSybaseASADriver;fmxdae;dbexpress;DataSnapIndy10ServerTransport;$(DCC_UsePackage)
+ System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)
+ $(BDS)\bin\delphi_PROJECTICON.ico
+ None
+ 1043
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=
+ lib
+ bin
+
+
+ dxdborRS16;cxLibraryRS16;dxLayoutControlRS16;dxPScxPivotGridLnkRS16;dxCoreRS16;cxExportRS16;dxBarRS16;cxSpreadSheetRS16;cxTreeListdxBarPopupMenuRS16;TeeDB;dxDBXServerModeRS16;dxPsPrVwAdvRS16;vclib;dxPSCoreRS16;cxPivotGridOLAPRS16;dxPScxTLLnkRS16;dxPScxGridLnkRS16;cxPageControlRS16;dxRibbonRS16;DBXSybaseASEDriver;vclimg;cxTreeListRS16;dxComnRS16;vcldb;dxADOServerModeRS16;vcldsnap;dxBarExtDBItemsRS16;DBXDb2Driver;vcl;DBXMSSQLDriver;cxDataRS16;cxBarEditItemRS16;dxDockingRS16;dxPSDBTeeChartRS16;cxPageControldxBarPopupMenuRS16;webdsnap;dxBarExtItemsRS16;dxPSLnksRS16;dxPSTeeChartRS16;adortl;dxPSdxLCLnkRS16;dxorgcRS16;dxWizardControlRS16;dxPScxExtCommonRS16;dxNavBarRS16;dxPSdxDBOCLnkRS16;cxSchedulerTreeBrowserRS16;Tee;DBXOdbcDriver;dxdbtrRS16;dxPScxSSLnkRS16;dxPScxCommonRS16;dxmdsRS16;dxPSPrVwRibbonRS16;cxGridRS16;cxEditorsRS16;TeeUI;vclactnband;dxServerModeRS16;bindcompvcl;cxPivotGridRS16;dxPScxSchedulerLnkRS16;dxPSdxDBTVLnkRS16;vclie;cxSchedulerRibbonStyleEventEditorRS16;cxSchedulerRS16;vcltouch;websnap;VclSmp;dxTabbedMDIRS16;DataSnapConnectors;dxPSdxOCLnkRS16;dsnapcon;dxPSdxFCLnkRS16;dxThemeRS16;dxPScxPCProdRS16;vclx;dxFlowChartRS16;dxGDIPlusRS16;dxBarDBNavRS16;$(DCC_UsePackage)
+
+
+ dxdborRS16;cxLibraryRS16;dxLayoutControlRS16;dxPScxPivotGridLnkRS16;dxCoreRS16;cxExportRS16;dxBarRS16;cxSpreadSheetRS16;cxTreeListdxBarPopupMenuRS16;TeeDB;dxDBXServerModeRS16;dxPsPrVwAdvRS16;vclib;inetdbbde;dxPSCoreRS16;cxPivotGridOLAPRS16;dxPScxTLLnkRS16;dxPScxGridLnkRS16;cxPageControlRS16;dxRibbonRS16;DBXSybaseASEDriver;vclimg;fmi;cxTreeListRS16;dxComnRS16;vcldb;dxADOServerModeRS16;vcldsnap;dxBarExtDBItemsRS16;X2CLGL;DBXDb2Driver;vcl;CloudService;DBXMSSQLDriver;CodeSiteExpressPkg;FmxTeeUI;cxDataRS16;cxBarEditItemRS16;dxDockingRS16;dxPSDBTeeChartRS16;cxPageControldxBarPopupMenuRS16;cxSchedulerGridRS16;webdsnap;X2CLMB;dxBarExtItemsRS16;dxPSLnksRS16;OmniThreadLibraryRuntimeXE2;dxtrmdRS16;dxPSTeeChartRS16;adortl;dxPSdxLCLnkRS16;madBasic_;dxorgcRS16;dxWizardControlRS16;dxPScxExtCommonRS16;vcldbx;dxNavBarRS16;dxPSdxDBOCLnkRS16;cxSchedulerTreeBrowserRS16;Tee;DBXOdbcDriver;dxdbtrRS16;madDisAsm_;svnui;dxPScxSSLnkRS16;dxPScxCommonRS16;dxmdsRS16;dxPSPrVwRibbonRS16;cxPivotGridChartRS16;cxGridRS16;cxEditorsRS16;FMXTee;TeeUI;vclactnband;dxServerModeRS16;bindcompvcl;cxPivotGridRS16;dxPScxSchedulerLnkRS16;dxPSdxDBTVLnkRS16;vclie;cxSchedulerRibbonStyleEventEditorRS16;cxSchedulerRS16;madExcept_;vcltouch;websnap;VclSmp;dxTabbedMDIRS16;DataSnapConnectors;dxPSdxOCLnkRS16;dsnapcon;dxPSdxFCLnkRS16;dxThemeRS16;dxPScxPCProdRS16;vclx;svn;dxFlowChartRS16;bdertl;VirtualTreesR;dxGDIPlusRS16;dxBarDBNavRS16;$(DCC_UsePackage)
+ true
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ 1033
+ $(BDS)\bin\default_app.manifest
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+ true
+ 1033
+ false
+
+
+ false
+ RELEASE;$(DCC_Define)
+ 0
+ false
+
+
+
+ MainSource
+
+
+
+ dfm
+ TService
+
+
+ Cfg_2
+ Base
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+
+ Delphi.Personality.12
+
+
+
+
+ False
+ False
+ 1
+ 0
+ 0
+ 0
+ False
+ False
+ False
+ False
+ False
+ 1043
+ 1252
+
+
+
+
+ 1.0.0.0
+
+
+
+
+
+ 1.0.0.0
+
+
+
+ X2LogServiceTest.dpr
+
+
+ JVCL Application and Form Components
+ JVCL Band Objects
+ JVCL BDE Components
+ JVCL Non-Visual Components
+ JVCL Visual Controls
+ JVCL Core Components
+ JVCL Encryption and Compression
+ JVCL Custom Controls
+ JVCL Database Components
+ JVCL Dialog Components
+ JVCL Docking Components
+ JVCL DotNet Controls
+ JVCL Globus Components
+ JVCL HMI Controls
+ JVCL Jans Components
+ JVCL Managed Threads
+ JVCL Multimedia and Image Components
+ JVCL Network Components
+ JVCL Page Style Components
+ JVCL Interpreter Components
+ JVCL Plugin Components
+ JVCL Print Preview Components
+ JVCL Runtime Design Components
+ JVCL Standard Controls
+ JVCL System Components
+ JVCL Time Framework
+ JVCL Wizard
+ JVCL XP Controls
+
+
+
+
+ False
+ True
+
+
+ 12
+
+
+
+
diff --git a/ServiceTest/X2LogServiceTest.res b/ServiceTest/X2LogServiceTest.res
new file mode 100644
index 0000000..c287ee9
Binary files /dev/null and b/ServiceTest/X2LogServiceTest.res differ
diff --git a/ServiceTest/source/ServiceDMU.dfm b/ServiceTest/source/ServiceDMU.dfm
new file mode 100644
index 0000000..7bbdef7
--- /dev/null
+++ b/ServiceTest/source/ServiceDMU.dfm
@@ -0,0 +1,13 @@
+object ServiceDM: TServiceDM
+ OldCreateOrder = False
+ DisplayName = 'X'#178'Log Test Service'
+ OnStart = ServiceStart
+ Height = 150
+ Width = 215
+ object tmrLog: TTimer
+ Interval = 5000
+ OnTimer = tmrLogTimer
+ Left = 88
+ Top = 56
+ end
+end
diff --git a/ServiceTest/source/ServiceDMU.pas b/ServiceTest/source/ServiceDMU.pas
new file mode 100644
index 0000000..244481e
--- /dev/null
+++ b/ServiceTest/source/ServiceDMU.pas
@@ -0,0 +1,67 @@
+unit ServiceDMU;
+
+interface
+uses
+ System.Classes,
+ System.SysUtils,
+ Vcl.Controls,
+ Vcl.Dialogs,
+ Vcl.ExtCtrls,
+ Vcl.Graphics,
+ Vcl.SvcMgr,
+ Winapi.Messages,
+ Winapi.Windows;
+
+
+type
+ TServiceDM = class(TService)
+ tmrLog: TTimer;
+
+ procedure ServiceStart(Sender: TService; var Started: Boolean);
+ procedure tmrLogTimer(Sender: TObject);
+ public
+ function GetServiceController: TServiceController; override;
+ end;
+
+
+var
+ ServiceDM: TServiceDM;
+
+
+implementation
+uses
+ X2Log.Intf,
+ X2Log.Global,
+ X2Log.Observer.NamedPipe;
+
+{$R *.DFM}
+
+
+procedure ServiceController(CtrlCode: DWord); stdcall;
+begin
+ ServiceDM.Controller(CtrlCode);
+end;
+
+
+function TServiceDM.GetServiceController: TServiceController;
+begin
+ Result := ServiceController;
+end;
+
+
+procedure TServiceDM.ServiceStart(Sender: TService; var Started: Boolean);
+begin
+ TX2GlobalLog.Attach(TX2LogNamedPipeObserver.Create('X2LogService', X2LogLevelsAll));
+end;
+
+
+procedure TServiceDM.tmrLogTimer(Sender: TObject);
+var
+ level: TX2LogLevel;
+
+begin
+ level := TX2LogLevel(Random(Ord(High(TX2LogLevel))));
+ TX2GlobalLog.Log(level, 'Ping!');
+end;
+
+end.
diff --git a/Test/X2LogTest.dpr b/Test/X2LogTest.dpr
index 9d2c5ca..abd45e0 100644
--- a/Test/X2LogTest.dpr
+++ b/Test/X2LogTest.dpr
@@ -21,7 +21,8 @@ uses
X2Log.Observer.MonitorForm in '..\X2Log.Observer.MonitorForm.pas' {X2LogObserverMonitorForm},
X2Log.Global in '..\X2Log.Global.pas',
X2Log.Client.NamedPipe in '..\X2Log.Client.NamedPipe.pas',
- X2Log.Client.Base in '..\X2Log.Client.Base.pas';
+ X2Log.Client.Base in '..\X2Log.Client.Base.pas',
+ X2Log.Registry.NamedPipe in '..\X2Log.Registry.NamedPipe.pas';
{$R *.res}
diff --git a/Test/X2LogTest.dproj b/Test/X2LogTest.dproj
index 73007d5..20a7b4e 100644
--- a/Test/X2LogTest.dproj
+++ b/Test/X2LogTest.dproj
@@ -192,6 +192,7 @@
+
Cfg_2
Base
diff --git a/Test/source/MainFrm.dfm b/Test/source/MainFrm.dfm
index 23f0f83..ca796fb 100644
--- a/Test/source/MainFrm.dfm
+++ b/Test/source/MainFrm.dfm
@@ -32,6 +32,10 @@ object MainForm: TMainForm
TabOrder = 0
object tsEvent: TTabSheet
Caption = 'Event Observer '
+ ExplicitLeft = 0
+ ExplicitTop = 0
+ ExplicitWidth = 0
+ ExplicitHeight = 0
object mmoEvent: TMemo
AlignWithMargins = True
Left = 8
@@ -69,8 +73,6 @@ object MainForm: TMainForm
end
object tsFile: TTabSheet
Caption = 'File Observer'
- ExplicitLeft = -108
- ExplicitTop = -5
object lblFilename: TLabel
Left = 12
Top = 64
@@ -135,6 +137,8 @@ object MainForm: TMainForm
Caption = 'Named Pipe Observer'
ExplicitLeft = 0
ExplicitTop = 30
+ ExplicitWidth = 0
+ ExplicitHeight = 0
object lblPipeName: TLabel
Left = 12
Top = 64
@@ -313,7 +317,7 @@ object MainForm: TMainForm
Left = 552
Top = 176
Bitmap = {
- 494C01010200140020000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
+ 494C01010200140024000C000C00FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000300000000C00000001002000000000000009
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
diff --git a/X2Log.Client.NamedPipe.pas b/X2Log.Client.NamedPipe.pas
index 08085f1..0264a91 100644
--- a/X2Log.Client.NamedPipe.pas
+++ b/X2Log.Client.NamedPipe.pas
@@ -70,7 +70,6 @@ const
ClearBufferTreshold = 4096;
-
{ TX2LogNamedPipeClient }
constructor TX2LogNamedPipeClient.Create(const APipeName: string);
begin
diff --git a/X2Log.Intf.pas b/X2Log.Intf.pas
index 44f2100..f92c7a2 100644
--- a/X2Log.Intf.pas
+++ b/X2Log.Intf.pas
@@ -8,6 +8,12 @@ type
TX2LogLevel = (Verbose, Info, Warning, Error);
+const
+ X2LogLevelsAll = [Low(TX2LogLevel)..High(TX2LogLevel)];
+ X2LogLevelsDefault = X2LogLevelsAll - [Verbose];
+
+
+type
IX2LogBase = interface
['{1949E8DC-6DC5-43DC-B678-55CF8274E79D}']
procedure Log(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = '');
diff --git a/X2Log.Observer.Custom.pas b/X2Log.Observer.Custom.pas
index 2b8284f..ce4ecaf 100644
--- a/X2Log.Observer.Custom.pas
+++ b/X2Log.Observer.Custom.pas
@@ -8,10 +8,6 @@ uses
X2Log.Intf;
-const
- X2LogLevelsAll = [Low(TX2LogLevel)..High(TX2LogLevel)];
- X2LogLevelsDefault = X2LogLevelsAll - [Verbose];
-
type
TX2LogLevels = set of TX2LogLevel;
diff --git a/X2Log.Observer.NamedPipe.pas b/X2Log.Observer.NamedPipe.pas
index 6b5776b..2401b42 100644
--- a/X2Log.Observer.NamedPipe.pas
+++ b/X2Log.Observer.NamedPipe.pas
@@ -86,6 +86,18 @@ type
end;
+
+ { Someone went through a lot of trouble to win at Scrabble... }
+ function ConvertStringSecurityDescriptorToSecurityDescriptorW(StringSecurityDescriptor: PWideChar;
+ StringSDRevision: DWORD;
+ SecurityDescriptor: PSECURITY_DESCRIPTOR;
+ SecurityDescriptorSize: PULONG): BOOL; stdcall; external advapi32;
+
+const
+ SDDL_REVISION_1 = 1;
+
+
+
{ TX2LogNamedPipeObserver }
constructor TX2LogNamedPipeObserver.Create(const APipeName: string; ALogLevels: TX2LogLevels);
begin
@@ -129,6 +141,8 @@ end;
procedure TX2LogNamedPipeClient.Send(AEntry: TX2LogQueueEntry);
begin
+ OutputDebugString(PChar(AEntry.Message));
+
if not Assigned(WriteBuffer) then
DoSend(AEntry)
else
@@ -378,13 +392,43 @@ const
DefaultTimeout = 5000;
var
+ security: TSecurityAttributes;
pipe: THandle;
client: TX2LogNamedPipeClient;
begin
- pipe := CreateNamedPipe(PChar('\\.\pipe\' + PipeName), PIPE_ACCESS_OUTBOUND or FILE_FLAG_OVERLAPPED,
- PIPE_TYPE_MESSAGE or PIPE_READMODE_MESSAGE or PIPE_WAIT, PIPE_UNLIMITED_INSTANCES,
- BufferSize, BufferSize, DefaultTimeout, nil);
+ FillChar(security, SizeOf(security), 0);
+ security.nLength := SizeOf(security);
+ security.bInheritHandle := False;
+
+ { Thanks to: http://www.osronline.com/showthread.cfm?link=204207
+ and: http://www.netid.washington.edu/documentation/domains/sddl.aspx
+
+ 0x12018d =
+ 0x00100000 - SYNCHRONIZE
+ 0x00020000 - READ_CONTROL
+ 0x00000100 - FILE_WRITE_ATTRIBUTES
+ 0x00000080 - FILE_READ_ATTRIBUTES
+ 0x00000008 - FILE_READ_EA
+ 0x00000004 - FILE_CREATE_PIPE_INSTANCE
+ 0x00000001 - FILE_READ_DATA }
+ if ConvertStringSecurityDescriptorToSecurityDescriptorW('D:' + // Discretionary ACL
+ '(D;;FA;;;NU)' + // Deny file all access (FA) to network user access (NU)
+ '(A;;0x12018d;;;WD)' + // Allow specific permissions for everyone (WD)
+ '(A;;0x12018d;;;CO)', // Allow specific permissions for creator owner (CO)
+ SDDL_REVISION_1,
+ @security.lpSecurityDescriptor,
+ nil) then
+ begin
+ try
+ pipe := CreateNamedPipe(PChar('\\.\pipe\' + 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
+ LocalFree(HLOCAL(security.lpSecurityDescriptor));
+ end;
+ end else
+ RaiseLastOSError;
if pipe <> INVALID_HANDLE_VALUE then
begin
diff --git a/X2Log.groupproj b/X2Log.groupproj
index 3c6d543..481a012 100644
--- a/X2Log.groupproj
+++ b/X2Log.groupproj
@@ -9,6 +9,9 @@
+
+
+
Default.Personality.12
@@ -35,14 +38,23 @@
+
+
+
+
+
+
+
+
+
-
+
-
+
-
+