Initial commit
This commit is contained in:
parent
c08ec03460
commit
895f496507
18
NamedPipeClient/X2LogNamedPipeClient.dpr
Normal file
18
NamedPipeClient/X2LogNamedPipeClient.dpr
Normal file
@ -0,0 +1,18 @@
|
|||||||
|
program X2LogNamedPipeClient;
|
||||||
|
|
||||||
|
uses
|
||||||
|
Vcl.Forms,
|
||||||
|
MainFrm in 'source\MainFrm.pas' {MainForm},
|
||||||
|
X2Log.Intf in '..\X2Log.Intf.pas';
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
var
|
||||||
|
MainForm: TMainForm;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application.Initialize;
|
||||||
|
Application.MainFormOnTaskbar := True;
|
||||||
|
Application.CreateForm(TMainForm, MainForm);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
178
NamedPipeClient/X2LogNamedPipeClient.dproj
Normal file
178
NamedPipeClient/X2LogNamedPipeClient.dproj
Normal file
@ -0,0 +1,178 @@
|
|||||||
|
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||||
|
<PropertyGroup>
|
||||||
|
<ProjectGuid>{883FC03C-9DB1-43A5-8053-5C920FDBCCAC}</ProjectGuid>
|
||||||
|
<ProjectVersion>13.4</ProjectVersion>
|
||||||
|
<FrameworkType>VCL</FrameworkType>
|
||||||
|
<MainSource>X2LogNamedPipeClient.dpr</MainSource>
|
||||||
|
<Base>True</Base>
|
||||||
|
<Config Condition="'$(Config)'==''">Debug</Config>
|
||||||
|
<Platform Condition="'$(Platform)'==''">Win32</Platform>
|
||||||
|
<TargetedPlatforms>1</TargetedPlatforms>
|
||||||
|
<AppType>Application</AppType>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
|
||||||
|
<Base_Win64>true</Base_Win64>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
|
||||||
|
<Base_Win32>true</Base_Win32>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
|
||||||
|
<Cfg_1>true</Cfg_1>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
|
||||||
|
<Cfg_1_Win32>true</Cfg_1_Win32>
|
||||||
|
<CfgParent>Cfg_1</CfgParent>
|
||||||
|
<Cfg_1>true</Cfg_1>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
|
||||||
|
<Cfg_2>true</Cfg_2>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Base)'!=''">
|
||||||
|
<DCC_UsePackage>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)</DCC_UsePackage>
|
||||||
|
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
|
||||||
|
<DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace)</DCC_Namespace>
|
||||||
|
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
||||||
|
<VerInfo_Locale>1043</VerInfo_Locale>
|
||||||
|
<Manifest_File>None</Manifest_File>
|
||||||
|
<DCC_DcuOutput>lib</DCC_DcuOutput>
|
||||||
|
<DCC_ExeOutput>bin</DCC_ExeOutput>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Base_Win64)'!=''">
|
||||||
|
<DCC_UsePackage>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)</DCC_UsePackage>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Base_Win32)'!=''">
|
||||||
|
<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)</DCC_UsePackage>
|
||||||
|
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
|
||||||
|
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
|
||||||
|
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||||
|
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
|
||||||
|
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Cfg_1)'!=''">
|
||||||
|
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
|
||||||
|
<DCC_Optimize>false</DCC_Optimize>
|
||||||
|
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
|
||||||
|
<DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
|
||||||
|
<DCC_RemoteDebug>true</DCC_RemoteDebug>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
|
||||||
|
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
|
||||||
|
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||||
|
<DCC_RemoteDebug>false</DCC_RemoteDebug>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Cfg_2)'!=''">
|
||||||
|
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
|
||||||
|
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
|
||||||
|
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
|
||||||
|
<DCC_DebugInformation>false</DCC_DebugInformation>
|
||||||
|
</PropertyGroup>
|
||||||
|
<ItemGroup>
|
||||||
|
<DelphiCompile Include="$(MainSource)">
|
||||||
|
<MainSource>MainSource</MainSource>
|
||||||
|
</DelphiCompile>
|
||||||
|
<DCCReference Include="source\MainFrm.pas">
|
||||||
|
<Form>MainForm</Form>
|
||||||
|
<FormType>dfm</FormType>
|
||||||
|
</DCCReference>
|
||||||
|
<DCCReference Include="..\X2Log.Intf.pas"/>
|
||||||
|
<BuildConfiguration Include="Release">
|
||||||
|
<Key>Cfg_2</Key>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
</BuildConfiguration>
|
||||||
|
<BuildConfiguration Include="Base">
|
||||||
|
<Key>Base</Key>
|
||||||
|
</BuildConfiguration>
|
||||||
|
<BuildConfiguration Include="Debug">
|
||||||
|
<Key>Cfg_1</Key>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
</BuildConfiguration>
|
||||||
|
</ItemGroup>
|
||||||
|
<ProjectExtensions>
|
||||||
|
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
|
||||||
|
<Borland.ProjectType/>
|
||||||
|
<BorlandProject>
|
||||||
|
<Delphi.Personality>
|
||||||
|
<VersionInfo>
|
||||||
|
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
|
||||||
|
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
|
||||||
|
<VersionInfo Name="MajorVer">1</VersionInfo>
|
||||||
|
<VersionInfo Name="MinorVer">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Release">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Build">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Debug">False</VersionInfo>
|
||||||
|
<VersionInfo Name="PreRelease">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Special">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Private">False</VersionInfo>
|
||||||
|
<VersionInfo Name="DLL">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Locale">1043</VersionInfo>
|
||||||
|
<VersionInfo Name="CodePage">1252</VersionInfo>
|
||||||
|
</VersionInfo>
|
||||||
|
<VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="CompanyName"/>
|
||||||
|
<VersionInfoKeys Name="FileDescription"/>
|
||||||
|
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="InternalName"/>
|
||||||
|
<VersionInfoKeys Name="LegalCopyright"/>
|
||||||
|
<VersionInfoKeys Name="LegalTrademarks"/>
|
||||||
|
<VersionInfoKeys Name="OriginalFilename"/>
|
||||||
|
<VersionInfoKeys Name="ProductName"/>
|
||||||
|
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="Comments"/>
|
||||||
|
</VersionInfoKeys>
|
||||||
|
<Source>
|
||||||
|
<Source Name="MainSource">X2LogNamedPipeClient.dpr</Source>
|
||||||
|
</Source>
|
||||||
|
<Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvAppFrmDesign160.bpl">JVCL Application and Form Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvBandsDesign160.bpl">JVCL Band Objects</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvBDEDesign160.bpl">JVCL BDE Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvCmpDesign160.bpl">JVCL Non-Visual Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvControlsDesign160.bpl">JVCL Visual Controls</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvCoreDesign160.bpl">JVCL Core Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvCryptDesign160.bpl">JVCL Encryption and Compression</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvCustomDesign160.bpl">JVCL Custom Controls</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvDBDesign160.bpl">JVCL Database Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvDlgsDesign160.bpl">JVCL Dialog Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvDockingDesign160.bpl">JVCL Docking Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvDotNetCtrlsDesign160.bpl">JVCL DotNet Controls</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvGlobusDesign160.bpl">JVCL Globus Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvHMIDesign160.bpl">JVCL HMI Controls</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvJansDesign160.bpl">JVCL Jans Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvManagedThreadsDesign160.bpl">JVCL Managed Threads</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvMMDesign160.bpl">JVCL Multimedia and Image Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvNetDesign160.bpl">JVCL Network Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvPageCompsDesign160.bpl">JVCL Page Style Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvPascalInterpreterDesign160.bpl">JVCL Interpreter Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvPluginSystemDesign160.bpl">JVCL Plugin Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvPrintPreviewDesign160.bpl">JVCL Print Preview Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvRuntimeDesignDesign160.bpl">JVCL Runtime Design Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvStdCtrlsDesign160.bpl">JVCL Standard Controls</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvSystemDesign160.bpl">JVCL System Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvTimeFrameworkDesign160.bpl">JVCL Time Framework</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvWizardsDesign160.bpl">JVCL Wizard</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvXPCtrlsDesign160.bpl">JVCL XP Controls</Excluded_Packages>
|
||||||
|
</Excluded_Packages>
|
||||||
|
</Delphi.Personality>
|
||||||
|
<Deployment/>
|
||||||
|
<Platforms>
|
||||||
|
<Platform value="Win64">False</Platform>
|
||||||
|
<Platform value="Win32">True</Platform>
|
||||||
|
</Platforms>
|
||||||
|
</BorlandProject>
|
||||||
|
<ProjectFileVersion>12</ProjectFileVersion>
|
||||||
|
</ProjectExtensions>
|
||||||
|
<Import Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')" Project="$(BDS)\Bin\CodeGear.Delphi.Targets"/>
|
||||||
|
<Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj"/>
|
||||||
|
</Project>
|
||||||
BIN
NamedPipeClient/X2LogNamedPipeClient.res
Normal file
BIN
NamedPipeClient/X2LogNamedPipeClient.res
Normal file
Binary file not shown.
27
NamedPipeClient/source/MainFrm.dfm
Normal file
27
NamedPipeClient/source/MainFrm.dfm
Normal file
@ -0,0 +1,27 @@
|
|||||||
|
object MainForm: TMainForm
|
||||||
|
Left = 0
|
||||||
|
Top = 0
|
||||||
|
Caption = 'X'#178'Log Named Pipe Client'
|
||||||
|
ClientHeight = 443
|
||||||
|
ClientWidth = 552
|
||||||
|
Color = clBtnFace
|
||||||
|
Font.Charset = DEFAULT_CHARSET
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -11
|
||||||
|
Font.Name = 'Tahoma'
|
||||||
|
Font.Style = []
|
||||||
|
OldCreateOrder = False
|
||||||
|
OnCreate = FormCreate
|
||||||
|
PixelsPerInch = 96
|
||||||
|
TextHeight = 13
|
||||||
|
object mmoLog: TMemo
|
||||||
|
Left = 0
|
||||||
|
Top = 0
|
||||||
|
Width = 552
|
||||||
|
Height = 443
|
||||||
|
Align = alClient
|
||||||
|
ReadOnly = True
|
||||||
|
ScrollBars = ssVertical
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
end
|
||||||
243
NamedPipeClient/source/MainFrm.pas
Normal file
243
NamedPipeClient/source/MainFrm.pas
Normal file
@ -0,0 +1,243 @@
|
|||||||
|
unit MainFrm;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
|
||||||
|
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TMainForm = class(TForm)
|
||||||
|
mmoLog: TMemo;
|
||||||
|
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
private
|
||||||
|
FClientThread: TThread;
|
||||||
|
|
||||||
|
procedure DoMessage(Sender: TObject; Msg: TStream);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
System.SyncObjs,
|
||||||
|
|
||||||
|
X2Log.Intf;
|
||||||
|
|
||||||
|
|
||||||
|
{$R *.dfm}
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TClientMessageEvent = procedure(Sender: TObject; Msg: TStream) of object;
|
||||||
|
|
||||||
|
TClientThread = class(TThread)
|
||||||
|
private
|
||||||
|
FTerminateEvent: TEvent;
|
||||||
|
FPipe: THandle;
|
||||||
|
FOverlappedRead: TOverlapped;
|
||||||
|
FReadBuffer: array[0..4095] of Byte;
|
||||||
|
FMessage: TMemoryStream;
|
||||||
|
FOnMessage: TClientMessageEvent;
|
||||||
|
protected
|
||||||
|
procedure Execute; override;
|
||||||
|
procedure TerminatedSet; override;
|
||||||
|
|
||||||
|
procedure ReadMessage;
|
||||||
|
procedure HandleMessage;
|
||||||
|
|
||||||
|
procedure DoMessage;
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
property OnMessage: TClientMessageEvent read FOnMessage write FOnMessage;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TMainForm }
|
||||||
|
procedure TMainForm.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FClientThread := TClientThread.Create;
|
||||||
|
(FClientThread as TClientThread).OnMessage := DoMessage;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TMainForm.DoMessage(Sender: TObject; Msg: TStream);
|
||||||
|
|
||||||
|
function ReadString: string;
|
||||||
|
var
|
||||||
|
size: Cardinal;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Msg.ReadBuffer(size, SizeOf(cardinal));
|
||||||
|
if size > 0 then
|
||||||
|
begin
|
||||||
|
SetLength(Result, size);
|
||||||
|
Msg.ReadBuffer(Result[1], size * SizeOf(Char));
|
||||||
|
end else
|
||||||
|
Result := '';
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
level: TX2LogLevel;
|
||||||
|
logMsg: string;
|
||||||
|
detail: string;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Msg.ReadBuffer(level, SizeOf(TX2LogLevel));
|
||||||
|
logMsg := ReadString;
|
||||||
|
detail := ReadString;
|
||||||
|
|
||||||
|
mmoLog.Lines.Add(logMsg + ' (' + detail + ')');
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
const
|
||||||
|
FILE_WRITE_ATTRIBUTES = $0100;
|
||||||
|
|
||||||
|
{ TClientThread }
|
||||||
|
constructor TClientThread.Create;
|
||||||
|
begin
|
||||||
|
FTerminateEvent := TEvent.Create(nil, True, False, '');
|
||||||
|
FMessage := TMemoryStream.Create;
|
||||||
|
|
||||||
|
inherited Create(False);
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TClientThread.Destroy;
|
||||||
|
begin
|
||||||
|
FreeAndNil(FMessage);
|
||||||
|
FreeAndNil(FTerminateEvent);
|
||||||
|
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TClientThread.Execute;
|
||||||
|
var
|
||||||
|
mode: Cardinal;
|
||||||
|
readEvent: TEvent;
|
||||||
|
events: array[0..1] of THandle;
|
||||||
|
waitResult: Cardinal;
|
||||||
|
bytesTransferred: Cardinal;
|
||||||
|
|
||||||
|
begin
|
||||||
|
while not Terminated do
|
||||||
|
begin
|
||||||
|
FPipe := CreateFile('\\.\pipe\X2LogTest', GENERIC_READ or FILE_WRITE_ATTRIBUTES,
|
||||||
|
0, nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0);
|
||||||
|
|
||||||
|
if FPipe = INVALID_HANDLE_VALUE then
|
||||||
|
begin
|
||||||
|
if GetLastError = ERROR_PIPE_BUSY then
|
||||||
|
begin
|
||||||
|
if not WaitNamedPipe('\\.\pipe\X2LogTest', 5000) then
|
||||||
|
exit;
|
||||||
|
end else
|
||||||
|
RaiseLastOSError;
|
||||||
|
end else
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if Terminated then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
mode := PIPE_READMODE_MESSAGE;
|
||||||
|
if not SetNamedPipeHandleState(FPipe, mode, nil, nil) then
|
||||||
|
exit;
|
||||||
|
|
||||||
|
readEvent := TEvent.Create(nil, False, False, '');
|
||||||
|
events[0] := FTerminateEvent.Handle;
|
||||||
|
events[1] := readEvent.Handle;
|
||||||
|
|
||||||
|
FOverlappedRead.hEvent := readEvent.Handle;
|
||||||
|
ReadMessage;
|
||||||
|
|
||||||
|
while not Terminated do
|
||||||
|
begin
|
||||||
|
waitResult := WaitForMultipleObjects(Length(events), @events, False, INFINITE);
|
||||||
|
|
||||||
|
case waitResult of
|
||||||
|
WAIT_OBJECT_0:
|
||||||
|
{ Terminated }
|
||||||
|
break;
|
||||||
|
|
||||||
|
WAIT_OBJECT_0 + 1:
|
||||||
|
{ Read event completed }
|
||||||
|
if GetOverlappedResult(FPipe, FOverlappedRead, bytesTransferred, False) then
|
||||||
|
begin
|
||||||
|
FMessage.WriteBuffer(FReadBuffer[0], bytesTransferred);
|
||||||
|
HandleMessage;
|
||||||
|
ReadMessage;
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
if GetLastError = ERROR_MORE_DATA then
|
||||||
|
begin
|
||||||
|
FMessage.WriteBuffer(FReadBuffer[0], bytesTransferred);
|
||||||
|
ReadMessage;
|
||||||
|
end else
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
CloseHandle(FPipe);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TClientThread.ReadMessage;
|
||||||
|
var
|
||||||
|
bytesRead: Cardinal;
|
||||||
|
lastError: Cardinal;
|
||||||
|
|
||||||
|
begin
|
||||||
|
while True do
|
||||||
|
begin
|
||||||
|
if ReadFile(FPipe, FReadBuffer, SizeOf(FReadBuffer), bytesRead, @FOverlappedRead) then
|
||||||
|
begin
|
||||||
|
{ Immediate result }
|
||||||
|
FMessage.WriteBuffer(FReadBuffer[0], bytesRead);
|
||||||
|
HandleMessage;
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
{ More data, pending I/O or an actual error }
|
||||||
|
lastError := GetLastError;
|
||||||
|
|
||||||
|
if lastError = ERROR_IO_PENDING then
|
||||||
|
break
|
||||||
|
else if lastError = ERROR_MORE_DATA then
|
||||||
|
FMessage.WriteBuffer(FReadBuffer[0], SizeOf(FReadBuffer))
|
||||||
|
else
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TClientThread.HandleMessage;
|
||||||
|
begin
|
||||||
|
if FMessage.Size > 0 then
|
||||||
|
begin
|
||||||
|
FMessage.Position := 0;
|
||||||
|
Synchronize(DoMessage);
|
||||||
|
FMessage.Clear;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TClientThread.TerminatedSet;
|
||||||
|
begin
|
||||||
|
inherited TerminatedSet;
|
||||||
|
|
||||||
|
FTerminateEvent.SetEvent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TClientThread.DoMessage;
|
||||||
|
begin
|
||||||
|
if Assigned(FOnMessage) then
|
||||||
|
FOnMessage(Self, FMessage);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
27
Test/X2LogTest.dpr
Normal file
27
Test/X2LogTest.dpr
Normal file
@ -0,0 +1,27 @@
|
|||||||
|
program X2LogTest;
|
||||||
|
|
||||||
|
uses
|
||||||
|
Forms,
|
||||||
|
MainFrm in 'source\MainFrm.pas' {MainForm},
|
||||||
|
X2Log.Intf in '..\X2Log.Intf.pas',
|
||||||
|
X2Log in '..\X2Log.pas',
|
||||||
|
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.Observer.LogFile in '..\X2Log.Observer.LogFile.pas',
|
||||||
|
X2Log.Constants in '..\X2Log.Constants.pas',
|
||||||
|
X2Log.Observer.NamedPipe in '..\X2Log.Observer.NamedPipe.pas',
|
||||||
|
X2Log.Observer.CustomThreaded in '..\X2Log.Observer.CustomThreaded.pas';
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
var
|
||||||
|
MainForm: TMainForm;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application.Initialize;
|
||||||
|
Application.MainFormOnTaskbar := True;
|
||||||
|
Application.CreateForm(TMainForm, MainForm);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
201
Test/X2LogTest.dproj
Normal file
201
Test/X2LogTest.dproj
Normal file
@ -0,0 +1,201 @@
|
|||||||
|
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||||
|
<PropertyGroup>
|
||||||
|
<ProjectGuid>{e601c684-e576-44d0-b94c-9a32de0c82c4}</ProjectGuid>
|
||||||
|
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
|
||||||
|
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
|
||||||
|
<DCC_DependencyCheckOutputName>X2LogTest.exe</DCC_DependencyCheckOutputName>
|
||||||
|
<MainSource>X2LogTest.dpr</MainSource>
|
||||||
|
<FrameworkType>VCL</FrameworkType>
|
||||||
|
<ProjectVersion>13.4</ProjectVersion>
|
||||||
|
<Base>True</Base>
|
||||||
|
<Config Condition="'$(Config)'==''">Debug</Config>
|
||||||
|
<Platform Condition="'$(Platform)'==''">Win32</Platform>
|
||||||
|
<TargetedPlatforms>1</TargetedPlatforms>
|
||||||
|
<AppType>Application</AppType>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
|
||||||
|
<Base_Win64>true</Base_Win64>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
|
||||||
|
<Base_Win32>true</Base_Win32>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
|
||||||
|
<Cfg_1>true</Cfg_1>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
|
||||||
|
<Cfg_1_Win32>true</Cfg_1_Win32>
|
||||||
|
<CfgParent>Cfg_1</CfgParent>
|
||||||
|
<Cfg_1>true</Cfg_1>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
|
||||||
|
<Cfg_2>true</Cfg_2>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
|
||||||
|
<Cfg_2_Win32>true</Cfg_2_Win32>
|
||||||
|
<CfgParent>Cfg_2</CfgParent>
|
||||||
|
<Cfg_2>true</Cfg_2>
|
||||||
|
<Base>true</Base>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Base)'!=''">
|
||||||
|
<Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
|
||||||
|
<DCC_ExeOutput>bin</DCC_ExeOutput>
|
||||||
|
<Manifest_File>None</Manifest_File>
|
||||||
|
<DCC_DcuOutput>lib</DCC_DcuOutput>
|
||||||
|
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace>
|
||||||
|
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
|
||||||
|
<VerInfo_Locale>1043</VerInfo_Locale>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Base_Win64)'!=''">
|
||||||
|
<Icon_MainIcon>X2LogTest_Icon.ico</Icon_MainIcon>
|
||||||
|
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Base_Win32)'!=''">
|
||||||
|
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
|
||||||
|
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
|
||||||
|
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||||
|
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Cfg_1)'!=''">
|
||||||
|
<Version>7.0</Version>
|
||||||
|
<DCC_DebugInformation>False</DCC_DebugInformation>
|
||||||
|
<DCC_LocalDebugSymbols>False</DCC_LocalDebugSymbols>
|
||||||
|
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
|
||||||
|
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
|
||||||
|
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
|
||||||
|
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
|
||||||
|
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Cfg_2)'!=''">
|
||||||
|
<Version>7.0</Version>
|
||||||
|
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
|
||||||
|
</PropertyGroup>
|
||||||
|
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
|
||||||
|
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
|
||||||
|
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
|
||||||
|
<VerInfo_Locale>1033</VerInfo_Locale>
|
||||||
|
</PropertyGroup>
|
||||||
|
<ProjectExtensions>
|
||||||
|
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
|
||||||
|
<Borland.ProjectType/>
|
||||||
|
<BorlandProject>
|
||||||
|
<Delphi.Personality>
|
||||||
|
<Parameters>
|
||||||
|
<Parameters Name="UseLauncher">False</Parameters>
|
||||||
|
<Parameters Name="LoadAllSymbols">True</Parameters>
|
||||||
|
<Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
|
||||||
|
</Parameters>
|
||||||
|
<VersionInfo>
|
||||||
|
<VersionInfo Name="IncludeVerInfo">False</VersionInfo>
|
||||||
|
<VersionInfo Name="AutoIncBuild">False</VersionInfo>
|
||||||
|
<VersionInfo Name="MajorVer">1</VersionInfo>
|
||||||
|
<VersionInfo Name="MinorVer">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Release">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Build">0</VersionInfo>
|
||||||
|
<VersionInfo Name="Debug">False</VersionInfo>
|
||||||
|
<VersionInfo Name="PreRelease">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Special">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Private">False</VersionInfo>
|
||||||
|
<VersionInfo Name="DLL">False</VersionInfo>
|
||||||
|
<VersionInfo Name="Locale">1043</VersionInfo>
|
||||||
|
<VersionInfo Name="CodePage">1252</VersionInfo>
|
||||||
|
</VersionInfo>
|
||||||
|
<VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="CompanyName"/>
|
||||||
|
<VersionInfoKeys Name="FileDescription"/>
|
||||||
|
<VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="InternalName"/>
|
||||||
|
<VersionInfoKeys Name="LegalCopyright"/>
|
||||||
|
<VersionInfoKeys Name="LegalTrademarks"/>
|
||||||
|
<VersionInfoKeys Name="OriginalFilename"/>
|
||||||
|
<VersionInfoKeys Name="ProductName"/>
|
||||||
|
<VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
|
||||||
|
<VersionInfoKeys Name="Comments"/>
|
||||||
|
</VersionInfoKeys>
|
||||||
|
<Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvAppFrmDesign160.bpl">JVCL Application and Form Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvBandsDesign160.bpl">JVCL Band Objects</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvBDEDesign160.bpl">JVCL BDE Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvCmpDesign160.bpl">JVCL Non-Visual Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvControlsDesign160.bpl">JVCL Visual Controls</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvCoreDesign160.bpl">JVCL Core Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvCryptDesign160.bpl">JVCL Encryption and Compression</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvCustomDesign160.bpl">JVCL Custom Controls</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvDBDesign160.bpl">JVCL Database Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvDlgsDesign160.bpl">JVCL Dialog Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvDockingDesign160.bpl">JVCL Docking Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvDotNetCtrlsDesign160.bpl">JVCL DotNet Controls</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvGlobusDesign160.bpl">JVCL Globus Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvHMIDesign160.bpl">JVCL HMI Controls</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvJansDesign160.bpl">JVCL Jans Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvManagedThreadsDesign160.bpl">JVCL Managed Threads</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvMMDesign160.bpl">JVCL Multimedia and Image Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvNetDesign160.bpl">JVCL Network Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvPageCompsDesign160.bpl">JVCL Page Style Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvPascalInterpreterDesign160.bpl">JVCL Interpreter Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvPluginSystemDesign160.bpl">JVCL Plugin Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvPrintPreviewDesign160.bpl">JVCL Print Preview Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvRuntimeDesignDesign160.bpl">JVCL Runtime Design Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvStdCtrlsDesign160.bpl">JVCL Standard Controls</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvSystemDesign160.bpl">JVCL System Components</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvTimeFrameworkDesign160.bpl">JVCL Time Framework</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvWizardsDesign160.bpl">JVCL Wizard</Excluded_Packages>
|
||||||
|
<Excluded_Packages Name="F:\Components\bin\DXE2\win32\JvXPCtrlsDesign160.bpl">JVCL XP Controls</Excluded_Packages>
|
||||||
|
</Excluded_Packages>
|
||||||
|
<Source>
|
||||||
|
<Source Name="MainSource">X2LogTest.dpr</Source>
|
||||||
|
</Source>
|
||||||
|
</Delphi.Personality>
|
||||||
|
<Platforms>
|
||||||
|
<Platform value="Win64">False</Platform>
|
||||||
|
<Platform value="Win32">True</Platform>
|
||||||
|
</Platforms>
|
||||||
|
</BorlandProject>
|
||||||
|
<ProjectFileVersion>12</ProjectFileVersion>
|
||||||
|
</ProjectExtensions>
|
||||||
|
<ItemGroup>
|
||||||
|
<DelphiCompile Include="$(MainSource)">
|
||||||
|
<MainSource>MainSource</MainSource>
|
||||||
|
</DelphiCompile>
|
||||||
|
<DCCReference Include="source\MainFrm.pas">
|
||||||
|
<Form>MainForm</Form>
|
||||||
|
</DCCReference>
|
||||||
|
<DCCReference Include="..\X2Log.Intf.pas"/>
|
||||||
|
<DCCReference Include="..\X2Log.pas"/>
|
||||||
|
<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.Observer.LogFile.pas"/>
|
||||||
|
<DCCReference Include="..\X2Log.Constants.pas"/>
|
||||||
|
<DCCReference Include="..\X2Log.Observer.NamedPipe.pas"/>
|
||||||
|
<DCCReference Include="..\X2Log.Observer.CustomThreaded.pas"/>
|
||||||
|
<BuildConfiguration Include="Debug">
|
||||||
|
<Key>Cfg_2</Key>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
</BuildConfiguration>
|
||||||
|
<BuildConfiguration Include="Base">
|
||||||
|
<Key>Base</Key>
|
||||||
|
</BuildConfiguration>
|
||||||
|
<BuildConfiguration Include="Release">
|
||||||
|
<Key>Cfg_1</Key>
|
||||||
|
<CfgParent>Base</CfgParent>
|
||||||
|
</BuildConfiguration>
|
||||||
|
</ItemGroup>
|
||||||
|
<ItemGroup/>
|
||||||
|
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets"/>
|
||||||
|
<Import Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')" Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj"/>
|
||||||
|
</Project>
|
||||||
BIN
Test/X2LogTest.res
Normal file
BIN
Test/X2LogTest.res
Normal file
Binary file not shown.
155
Test/source/MainFrm.dfm
Normal file
155
Test/source/MainFrm.dfm
Normal file
@ -0,0 +1,155 @@
|
|||||||
|
object MainForm: TMainForm
|
||||||
|
Left = 0
|
||||||
|
Top = 0
|
||||||
|
Caption = 'X'#178'Log Test'
|
||||||
|
ClientHeight = 515
|
||||||
|
ClientWidth = 611
|
||||||
|
Color = clBtnFace
|
||||||
|
Font.Charset = DEFAULT_CHARSET
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -11
|
||||||
|
Font.Name = 'Tahoma'
|
||||||
|
Font.Style = []
|
||||||
|
OldCreateOrder = False
|
||||||
|
Position = poScreenCenter
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnDestroy = FormDestroy
|
||||||
|
PixelsPerInch = 96
|
||||||
|
TextHeight = 13
|
||||||
|
object pcObservers: TPageControl
|
||||||
|
AlignWithMargins = True
|
||||||
|
Left = 8
|
||||||
|
Top = 113
|
||||||
|
Width = 595
|
||||||
|
Height = 361
|
||||||
|
Margins.Left = 8
|
||||||
|
Margins.Top = 8
|
||||||
|
Margins.Right = 8
|
||||||
|
Margins.Bottom = 8
|
||||||
|
ActivePage = tsNamedPipe
|
||||||
|
Align = alClient
|
||||||
|
TabOrder = 0
|
||||||
|
OnChange = pcObserversChange
|
||||||
|
object tsEvent: TTabSheet
|
||||||
|
Caption = 'Event Observer '
|
||||||
|
object mmoEvent: TMemo
|
||||||
|
AlignWithMargins = True
|
||||||
|
Left = 8
|
||||||
|
Top = 8
|
||||||
|
Width = 571
|
||||||
|
Height = 317
|
||||||
|
Margins.Left = 8
|
||||||
|
Margins.Top = 8
|
||||||
|
Margins.Right = 8
|
||||||
|
Margins.Bottom = 8
|
||||||
|
Align = alClient
|
||||||
|
ReadOnly = True
|
||||||
|
ScrollBars = ssVertical
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object tsFile: TTabSheet
|
||||||
|
Caption = 'File Observer'
|
||||||
|
ImageIndex = 1
|
||||||
|
end
|
||||||
|
object tsNamedPipe: TTabSheet
|
||||||
|
Caption = 'Named Pipe Observer'
|
||||||
|
ImageIndex = 2
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object pnlButtons: TPanel
|
||||||
|
AlignWithMargins = True
|
||||||
|
Left = 8
|
||||||
|
Top = 482
|
||||||
|
Width = 595
|
||||||
|
Height = 25
|
||||||
|
Margins.Left = 8
|
||||||
|
Margins.Top = 0
|
||||||
|
Margins.Right = 8
|
||||||
|
Margins.Bottom = 8
|
||||||
|
Align = alBottom
|
||||||
|
BevelOuter = bvNone
|
||||||
|
TabOrder = 1
|
||||||
|
object btnClose: TButton
|
||||||
|
Left = 520
|
||||||
|
Top = 0
|
||||||
|
Width = 75
|
||||||
|
Height = 25
|
||||||
|
Align = alRight
|
||||||
|
Cancel = True
|
||||||
|
Caption = 'Close'
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
end
|
||||||
|
object GroupBox1: TGroupBox
|
||||||
|
AlignWithMargins = True
|
||||||
|
Left = 8
|
||||||
|
Top = 8
|
||||||
|
Width = 595
|
||||||
|
Height = 97
|
||||||
|
Margins.Left = 8
|
||||||
|
Margins.Top = 8
|
||||||
|
Margins.Right = 8
|
||||||
|
Margins.Bottom = 0
|
||||||
|
Align = alTop
|
||||||
|
Caption = ' Dispatch '
|
||||||
|
TabOrder = 2
|
||||||
|
DesignSize = (
|
||||||
|
595
|
||||||
|
97)
|
||||||
|
object lblMessage: TLabel
|
||||||
|
Left = 16
|
||||||
|
Top = 32
|
||||||
|
Width = 46
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Message:'
|
||||||
|
end
|
||||||
|
object lblException: TLabel
|
||||||
|
Left = 16
|
||||||
|
Top = 59
|
||||||
|
Width = 51
|
||||||
|
Height = 13
|
||||||
|
Caption = 'Exception:'
|
||||||
|
end
|
||||||
|
object edtMessage: TEdit
|
||||||
|
Left = 92
|
||||||
|
Top = 29
|
||||||
|
Width = 402
|
||||||
|
Height = 21
|
||||||
|
Anchors = [akLeft, akTop, akRight]
|
||||||
|
TabOrder = 0
|
||||||
|
Text = 'Hello world!'
|
||||||
|
OnKeyDown = edtMessageKeyDown
|
||||||
|
end
|
||||||
|
object btnSend: TButton
|
||||||
|
Left = 500
|
||||||
|
Top = 29
|
||||||
|
Width = 75
|
||||||
|
Height = 21
|
||||||
|
Anchors = [akLeft, akTop, akRight]
|
||||||
|
Caption = '&Send'
|
||||||
|
TabOrder = 1
|
||||||
|
OnClick = btnSendClick
|
||||||
|
end
|
||||||
|
object edtException: TEdit
|
||||||
|
Left = 92
|
||||||
|
Top = 56
|
||||||
|
Width = 402
|
||||||
|
Height = 21
|
||||||
|
Anchors = [akLeft, akTop, akRight]
|
||||||
|
TabOrder = 2
|
||||||
|
Text = 'Horrible things are happening.'
|
||||||
|
OnKeyDown = edtExceptionKeyDown
|
||||||
|
end
|
||||||
|
object btnException: TButton
|
||||||
|
Left = 500
|
||||||
|
Top = 56
|
||||||
|
Width = 75
|
||||||
|
Height = 21
|
||||||
|
Anchors = [akLeft, akTop, akRight]
|
||||||
|
Caption = '&Send'
|
||||||
|
TabOrder = 3
|
||||||
|
OnClick = btnExceptionClick
|
||||||
|
end
|
||||||
|
end
|
||||||
|
end
|
||||||
167
Test/source/MainFrm.pas
Normal file
167
Test/source/MainFrm.pas
Normal file
@ -0,0 +1,167 @@
|
|||||||
|
unit MainFrm;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
System.Classes,
|
||||||
|
Vcl.ComCtrls,
|
||||||
|
Vcl.Controls,
|
||||||
|
Vcl.ExtCtrls,
|
||||||
|
Vcl.Forms,
|
||||||
|
Vcl.StdCtrls,
|
||||||
|
|
||||||
|
X2Log.Intf;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TMainForm = class(TForm)
|
||||||
|
btnClose: TButton;
|
||||||
|
btnSend: TButton;
|
||||||
|
edtMessage: TEdit;
|
||||||
|
GroupBox1: TGroupBox;
|
||||||
|
lblMessage: TLabel;
|
||||||
|
mmoEvent: TMemo;
|
||||||
|
pcObservers: TPageControl;
|
||||||
|
pnlButtons: TPanel;
|
||||||
|
tsEvent: TTabSheet;
|
||||||
|
tsFile: TTabSheet;
|
||||||
|
lblException: TLabel;
|
||||||
|
edtException: TEdit;
|
||||||
|
btnException: TButton;
|
||||||
|
tsNamedPipe: TTabSheet;
|
||||||
|
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure FormDestroy(Sender: TObject);
|
||||||
|
procedure pcObserversChange(Sender: TObject);
|
||||||
|
procedure btnSendClick(Sender: TObject);
|
||||||
|
procedure edtExceptionKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||||
|
procedure edtMessageKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||||
|
procedure btnExceptionClick(Sender: TObject);
|
||||||
|
private
|
||||||
|
FLog: IX2Log;
|
||||||
|
FObserver: IX2LogObserver;
|
||||||
|
protected
|
||||||
|
procedure InitObserver;
|
||||||
|
|
||||||
|
procedure DoLog(Sender: TObject; Level: TX2LogLevel; const Msg, Details: string);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
Winapi.Windows,
|
||||||
|
|
||||||
|
X2Log,
|
||||||
|
X2Log.Constants,
|
||||||
|
X2Log.Exception.madExcept,
|
||||||
|
X2Log.Observer.Event,
|
||||||
|
X2Log.Observer.LogFile,
|
||||||
|
X2Log.Observer.NamedPipe;
|
||||||
|
|
||||||
|
|
||||||
|
{$R *.dfm}
|
||||||
|
|
||||||
|
|
||||||
|
{ TMainForm }
|
||||||
|
procedure TMainForm.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
SetLogResourceString(@LogLevelVerbose, 'Uitgebreid');
|
||||||
|
SetLogResourceString(@LogLevelInfo, 'Informatie');
|
||||||
|
SetLogResourceString(@LogLevelWarning, 'Waarschuwing');
|
||||||
|
SetLogResourceString(@LogLevelError, 'Fout');
|
||||||
|
|
||||||
|
FLog := TX2Log.Create;
|
||||||
|
FLog.SetExceptionStrategy(TX2LogmadExceptExceptionStrategy.Create);
|
||||||
|
|
||||||
|
pcObservers.ActivePageIndex := 0;
|
||||||
|
InitObserver;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TMainForm.FormDestroy(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FLog := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TMainForm.InitObserver;
|
||||||
|
var
|
||||||
|
activePage: TTabSheet;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if Assigned(FObserver) then
|
||||||
|
begin
|
||||||
|
FLog.Detach(FObserver);
|
||||||
|
FObserver := nil;
|
||||||
|
end;
|
||||||
|
|
||||||
|
activePage := pcObservers.ActivePage;
|
||||||
|
|
||||||
|
if activePage = tsEvent then
|
||||||
|
FObserver := TX2LogEventObserver.Create(DoLog)
|
||||||
|
else if activePage = tsFile then
|
||||||
|
FObserver := TX2LogFileObserver.CreateInProgramData('X2LogTest\Test.log');
|
||||||
|
|
||||||
|
if activePage = tsNamedPipe then
|
||||||
|
begin
|
||||||
|
FObserver := TX2LogNamedPipeObserver.Create('X2LogTest');
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
if Assigned(FObserver) then
|
||||||
|
FLog.Attach(FObserver);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TMainForm.DoLog(Sender: TObject; Level: TX2LogLevel; const Msg, Details: string);
|
||||||
|
begin
|
||||||
|
mmoEvent.Lines.Add(GetLogLevelText(Level) + ': ' + Msg + ' (' + Details + ')');
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TMainForm.edtMessageKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||||
|
begin
|
||||||
|
if Key = VK_RETURN then
|
||||||
|
begin
|
||||||
|
btnException.Click;
|
||||||
|
Key := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TMainForm.edtExceptionKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||||
|
begin
|
||||||
|
if Key = VK_RETURN then
|
||||||
|
begin
|
||||||
|
btnException.Click;
|
||||||
|
Key := 0;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TMainForm.pcObserversChange(Sender: TObject);
|
||||||
|
begin
|
||||||
|
InitObserver;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TMainForm.btnSendClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
FLog.Info(edtMessage.Text);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TMainForm.btnExceptionClick(Sender: TObject);
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
{ Throw an actual exception, don't just create it, to allow
|
||||||
|
strategies like madExcept to do their stack trace }
|
||||||
|
raise EAbort.Create(edtException.Text);
|
||||||
|
except
|
||||||
|
on E:Exception do
|
||||||
|
FLog.Exception(E);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
89
X2Log.Constants.pas
Normal file
89
X2Log.Constants.pas
Normal file
@ -0,0 +1,89 @@
|
|||||||
|
unit X2Log.Constants;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
X2Log.Intf;
|
||||||
|
|
||||||
|
|
||||||
|
resourcestring
|
||||||
|
LogLevelVerbose = 'Verbose';
|
||||||
|
LogLevelInfo = 'Info';
|
||||||
|
LogLevelWarning = 'Warning';
|
||||||
|
LogLevelError = 'Error';
|
||||||
|
|
||||||
|
|
||||||
|
{
|
||||||
|
X2Log.Observer.LogFile
|
||||||
|
}
|
||||||
|
|
||||||
|
{ Date format used to determine the file name of detail files }
|
||||||
|
LogFileNameDateFormat = 'ddmmyyyy_hhnn';
|
||||||
|
|
||||||
|
{ Date format used in log files }
|
||||||
|
LogFileLineDateFormat = 'dd-mm-yy hh:nn';
|
||||||
|
|
||||||
|
{ The text added to the message if details are stored externally }
|
||||||
|
LogFileLineDetails = ' (details: %s)';
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
function GetLogLevelText(ALogLevel: TX2LogLevel): string;
|
||||||
|
|
||||||
|
function GetLogResourceString(AResourceString: Pointer): string;
|
||||||
|
procedure SetLogResourceString(AResourceString: Pointer; const AValue: string);
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
System.Generics.Collections,
|
||||||
|
System.SysUtils;
|
||||||
|
|
||||||
|
|
||||||
|
var
|
||||||
|
LogResourceStringMap: TDictionary<Pointer,string>;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
function GetLogLevelText(ALogLevel: TX2LogLevel): string;
|
||||||
|
begin
|
||||||
|
case ALogLevel of
|
||||||
|
TX2LogLevel.Verbose: Result := GetLogResourceString(@LogLevelVerbose);
|
||||||
|
TX2LogLevel.Info: Result := GetLogResourceString(@LogLevelInfo);
|
||||||
|
TX2LogLevel.Warning: Result := GetLogResourceString(@LogLevelWarning);
|
||||||
|
TX2LogLevel.Error: Result := GetLogResourceString(@LogLevelError);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function GetLogResourceString(AResourceString: Pointer): string;
|
||||||
|
begin
|
||||||
|
TMonitor.Enter(LogResourceStringMap);
|
||||||
|
try
|
||||||
|
if LogResourceStringMap.ContainsKey(AResourceString) then
|
||||||
|
Result := LogResourceStringMap[AResourceString]
|
||||||
|
else
|
||||||
|
Result := LoadResString(AResourceString);
|
||||||
|
finally
|
||||||
|
TMonitor.Exit(LogResourceStringMap);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure SetLogResourceString(AResourceString: Pointer; const AValue: string);
|
||||||
|
begin
|
||||||
|
TMonitor.Enter(LogResourceStringMap);
|
||||||
|
try
|
||||||
|
LogResourceStringMap.AddOrSetValue(AResourceString, AValue);
|
||||||
|
finally
|
||||||
|
TMonitor.Exit(LogResourceStringMap);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
initialization
|
||||||
|
LogResourceStringMap := TDictionary<Pointer,string>.Create;
|
||||||
|
|
||||||
|
finalization
|
||||||
|
FreeAndNil(LogResourceStringMap);
|
||||||
|
|
||||||
|
end.
|
||||||
30
X2Log.Exception.Default.pas
Normal file
30
X2Log.Exception.Default.pas
Normal file
@ -0,0 +1,30 @@
|
|||||||
|
unit X2Log.Exception.Default;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
|
||||||
|
X2Log.Intf;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TX2LogDefaultExceptionStrategy = class(TInterfacedObject, IX2LogExceptionStrategy)
|
||||||
|
public
|
||||||
|
{ IX2LogExceptionStrategy }
|
||||||
|
procedure Execute(AException: Exception; var AMessage: string; var ADetails: string); virtual;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
{ TX2LogDefaultExceptionStrategy }
|
||||||
|
procedure TX2LogDefaultExceptionStrategy.Execute(AException: Exception; var AMessage, ADetails: string);
|
||||||
|
begin
|
||||||
|
if Length(AMessage) > 0 then
|
||||||
|
AMessage := AMessage + ': ';
|
||||||
|
|
||||||
|
AMessage := AMessage + AException.Message;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
35
X2Log.Exception.madExcept.pas
Normal file
35
X2Log.Exception.madExcept.pas
Normal file
@ -0,0 +1,35 @@
|
|||||||
|
unit X2Log.Exception.madExcept;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
System.SysUtils,
|
||||||
|
|
||||||
|
X2Log.Intf,
|
||||||
|
X2Log.Exception.Default;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TX2LogmadExceptExceptionStrategy = class(TX2LogDefaultExceptionStrategy)
|
||||||
|
public
|
||||||
|
{ IX2LogExceptionStrategy }
|
||||||
|
procedure Execute(AException: Exception; var AMessage: string; var ADetails: string); override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
madExcept;
|
||||||
|
|
||||||
|
|
||||||
|
{ TX2LogmadExceptExceptionStrategy }
|
||||||
|
procedure TX2LogmadExceptExceptionStrategy.Execute(AException: Exception; var AMessage, ADetails: string);
|
||||||
|
begin
|
||||||
|
inherited Execute(AException, AMessage, ADetails);
|
||||||
|
|
||||||
|
if Length(ADetails) > 0 then
|
||||||
|
ADetails := ADetails + #13#10;
|
||||||
|
|
||||||
|
ADetails := ADetails + madExcept.CreateBugReport(etNormal, AException);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
45
X2Log.Intf.pas
Normal file
45
X2Log.Intf.pas
Normal file
@ -0,0 +1,45 @@
|
|||||||
|
unit X2Log.Intf;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
System.SysUtils;
|
||||||
|
|
||||||
|
type
|
||||||
|
TX2LogLevel = (Verbose, Info, Warning, Error);
|
||||||
|
|
||||||
|
|
||||||
|
IX2LogMethods = interface
|
||||||
|
['{1949E8DC-6DC5-43DC-B678-55CF8274E79D}']
|
||||||
|
procedure Log(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = '');
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
IX2LogObserver = interface(IX2LogMethods)
|
||||||
|
['{CBC5C18E-84EE-43F4-8DBE-C66D06FCDE74}']
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
IX2LogExceptionStrategy = interface
|
||||||
|
['{C0B7950E-BE0A-4A21-A7C5-F8322FD4E205}']
|
||||||
|
procedure Execute(AException: Exception; var AMessage: string; var ADetails: string);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
IX2Log = interface(IX2LogMethods)
|
||||||
|
['{A6FF38F9-EDA8-4C76-9C95-2C0317560D78}']
|
||||||
|
procedure Attach(AObserver: IX2LogObserver);
|
||||||
|
procedure Detach(AObserver: IX2LogObserver);
|
||||||
|
|
||||||
|
procedure SetExceptionStrategy(AStrategy: IX2LogExceptionStrategy);
|
||||||
|
|
||||||
|
procedure Verbose(const AMessage: string; const ADetails: string = '');
|
||||||
|
procedure Info(const AMessage: string; const ADetails: string = '');
|
||||||
|
procedure Warning(const AMessage: string; const ADetails: string = '');
|
||||||
|
procedure Error(const AMessage: string; const ADetails: string = '');
|
||||||
|
procedure Exception(AException: Exception; const AMessage: string = ''; const ADetails: string = '');
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
end.
|
||||||
52
X2Log.Observer.Custom.pas
Normal file
52
X2Log.Observer.Custom.pas
Normal file
@ -0,0 +1,52 @@
|
|||||||
|
unit X2Log.Observer.Custom;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
Classes,
|
||||||
|
SysUtils,
|
||||||
|
|
||||||
|
X2Log.Intf;
|
||||||
|
|
||||||
|
|
||||||
|
const
|
||||||
|
X2LogLevelsAll = [Low(TX2LogLevel)..High(TX2LogLevel)];
|
||||||
|
X2LogLevelsDefault = X2LogLevelsAll - [Verbose];
|
||||||
|
|
||||||
|
type
|
||||||
|
TX2LogLevels = set of TX2LogLevel;
|
||||||
|
|
||||||
|
TX2LogCustomObserver = class(TInterfacedObject, IX2LogObserver)
|
||||||
|
private
|
||||||
|
FLogLevels: TX2LogLevels;
|
||||||
|
protected
|
||||||
|
procedure DoLog(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = ''); virtual; abstract;
|
||||||
|
|
||||||
|
{ IX2LogObserver }
|
||||||
|
procedure Log(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = ''); virtual;
|
||||||
|
|
||||||
|
property LogLevels: TX2LogLevels read FLogLevels;
|
||||||
|
public
|
||||||
|
constructor Create(ALogLevels: TX2LogLevels = X2LogLevelsDefault);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
{ TX2LogCustomObserver }
|
||||||
|
constructor TX2LogCustomObserver.Create(ALogLevels: TX2LogLevels);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
|
||||||
|
FLogLevels := ALogLevels;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogCustomObserver.Log(ALevel: TX2LogLevel; const AMessage, ADetails: string);
|
||||||
|
begin
|
||||||
|
if ALevel in LogLevels then
|
||||||
|
DoLog(ALevel, AMessage, ADetails);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
235
X2Log.Observer.CustomThreaded.pas
Normal file
235
X2Log.Observer.CustomThreaded.pas
Normal file
@ -0,0 +1,235 @@
|
|||||||
|
unit X2Log.Observer.CustomThreaded;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
System.Classes,
|
||||||
|
System.Generics.Collections,
|
||||||
|
System.SyncObjs,
|
||||||
|
|
||||||
|
X2Log.Intf,
|
||||||
|
X2Log.Observer.Custom;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TX2LogObserverWorkerThread = class;
|
||||||
|
|
||||||
|
|
||||||
|
TX2LogCustomThreadedObserver = class(TX2LogCustomObserver)
|
||||||
|
private
|
||||||
|
FWorkerThread: TX2LogObserverWorkerThread;
|
||||||
|
protected
|
||||||
|
function CreateWorkerThread: TX2LogObserverWorkerThread; virtual; abstract;
|
||||||
|
|
||||||
|
procedure DoLog(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = ''); override;
|
||||||
|
|
||||||
|
property WorkerThread: TX2LogObserverWorkerThread read FWorkerThread;
|
||||||
|
public
|
||||||
|
constructor Create(ALogLevels: TX2LogLevels = X2LogLevelsDefault);
|
||||||
|
destructor Destroy; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TX2LogQueueEntry = class(TPersistent)
|
||||||
|
private
|
||||||
|
FDetails: string;
|
||||||
|
FLevel: TX2LogLevel;
|
||||||
|
FMessage: string;
|
||||||
|
public
|
||||||
|
constructor Create(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string); overload;
|
||||||
|
constructor Create(AEntry: TX2LogQueueEntry); overload;
|
||||||
|
|
||||||
|
procedure Assign(Source: TPersistent); override;
|
||||||
|
|
||||||
|
property Details: string read FDetails;
|
||||||
|
property Level: TX2LogLevel read FLevel;
|
||||||
|
property Message: string read FMessage;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TX2LogObserverWorkerThread = class(TThread)
|
||||||
|
private
|
||||||
|
FFileName: string;
|
||||||
|
FLogQueue: TObjectQueue<TX2LogQueueEntry>;
|
||||||
|
FLogQueueSignal: TEvent;
|
||||||
|
protected
|
||||||
|
procedure Execute; override;
|
||||||
|
procedure TerminatedSet; override;
|
||||||
|
|
||||||
|
procedure Setup; virtual;
|
||||||
|
procedure Cleanup; virtual;
|
||||||
|
|
||||||
|
procedure WaitForEntry; virtual;
|
||||||
|
procedure ProcessEntry(AEntry: TX2LogQueueEntry); virtual; abstract;
|
||||||
|
|
||||||
|
property FileName: string read FFileName;
|
||||||
|
property LogQueue: TObjectQueue<TX2LogQueueEntry> read FLogQueue;
|
||||||
|
property LogQueueSignal: TEvent read FLogQueueSignal;
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
procedure Log(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = '');
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
System.SysUtils;
|
||||||
|
|
||||||
|
|
||||||
|
{ TX2LogCustomThreadedObserver }
|
||||||
|
constructor TX2LogCustomThreadedObserver.Create(ALogLevels: TX2LogLevels);
|
||||||
|
begin
|
||||||
|
inherited Create(ALogLevels);
|
||||||
|
|
||||||
|
FWorkerThread := CreateWorkerThread;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
destructor TX2LogCustomThreadedObserver.Destroy;
|
||||||
|
begin
|
||||||
|
FreeAndNil(FWorkerThread);
|
||||||
|
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogCustomThreadedObserver.DoLog(ALevel: TX2LogLevel; const AMessage, ADetails: string);
|
||||||
|
begin
|
||||||
|
WorkerThread.Log(ALevel, AMessage, ADetails);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{ TX2LogQueueEntry }
|
||||||
|
constructor TX2LogQueueEntry.Create(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
|
||||||
|
FLevel := ALevel;
|
||||||
|
FMessage := AMessage;
|
||||||
|
FDetails := ADetails;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
constructor TX2LogQueueEntry.Create(AEntry: TX2LogQueueEntry);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
|
||||||
|
Assign(AEntry);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogQueueEntry.Assign(Source: TPersistent);
|
||||||
|
var
|
||||||
|
entrySource: TX2LogQueueEntry;
|
||||||
|
|
||||||
|
begin
|
||||||
|
if Source is TX2LogQueueEntry then
|
||||||
|
begin
|
||||||
|
entrySource := TX2LogQueueEntry(Source);
|
||||||
|
|
||||||
|
FLevel := entrySource.Level;
|
||||||
|
FMessage := entrySource.Message;
|
||||||
|
FDetails := entrySource.Details;
|
||||||
|
end else
|
||||||
|
inherited Assign(Source);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TX2LogObserverWorkerThread }
|
||||||
|
constructor TX2LogObserverWorkerThread.Create;
|
||||||
|
begin
|
||||||
|
FLogQueueSignal := TEvent.Create(nil, False, False, '');
|
||||||
|
FLogQueue := TObjectQueue<TX2LogQueueEntry>.Create(True);
|
||||||
|
|
||||||
|
inherited Create(False);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
destructor TX2LogObserverWorkerThread.Destroy;
|
||||||
|
begin
|
||||||
|
inherited Destroy;
|
||||||
|
|
||||||
|
FreeAndNil(FLogQueue);
|
||||||
|
FreeAndNil(FLogQueueSignal);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogObserverWorkerThread.Log(ALevel: TX2LogLevel; const AMessage, ADetails: string);
|
||||||
|
begin
|
||||||
|
TMonitor.Enter(LogQueue);
|
||||||
|
try
|
||||||
|
LogQueue.Enqueue(TX2LogQueueEntry.Create(ALevel, AMessage, ADetails));
|
||||||
|
finally
|
||||||
|
TMonitor.Exit(LogQueue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
LogQueueSignal.SetEvent;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogObserverWorkerThread.Execute;
|
||||||
|
var
|
||||||
|
entry: TX2LogQueueEntry;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Setup;
|
||||||
|
try
|
||||||
|
while not Terminated do
|
||||||
|
begin
|
||||||
|
WaitForEntry;
|
||||||
|
|
||||||
|
if Terminated then
|
||||||
|
break;
|
||||||
|
|
||||||
|
entry := nil;
|
||||||
|
TMonitor.Enter(LogQueue);
|
||||||
|
try
|
||||||
|
if LogQueue.Count > 0 then
|
||||||
|
entry := LogQueue.Extract;
|
||||||
|
finally
|
||||||
|
TMonitor.Exit(LogQueue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
if Assigned(entry) then
|
||||||
|
try
|
||||||
|
ProcessEntry(entry);
|
||||||
|
finally
|
||||||
|
FreeAndNil(entry);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
Cleanup;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogObserverWorkerThread.Setup;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogObserverWorkerThread.Cleanup;
|
||||||
|
begin
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogObserverWorkerThread.WaitForEntry;
|
||||||
|
begin
|
||||||
|
case LogQueueSignal.WaitFor(INFINITE) of
|
||||||
|
wrAbandoned,
|
||||||
|
wrError:
|
||||||
|
Terminate;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogObserverWorkerThread.TerminatedSet;
|
||||||
|
begin
|
||||||
|
LogQueueSignal.SetEvent;
|
||||||
|
|
||||||
|
inherited TerminatedSet;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
50
X2Log.Observer.Event.pas
Normal file
50
X2Log.Observer.Event.pas
Normal file
@ -0,0 +1,50 @@
|
|||||||
|
unit X2Log.Observer.Event;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
X2Log.Intf,
|
||||||
|
X2Log.Observer.Custom;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TX2LogEvent = procedure(Sender: TObject; Level: TX2LogLevel; const Msg, Details: string) of object;
|
||||||
|
|
||||||
|
|
||||||
|
TX2LogEventObserver = class(TX2LogCustomObserver)
|
||||||
|
private
|
||||||
|
FOnLog: TX2LogEvent;
|
||||||
|
protected
|
||||||
|
procedure DoLog(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = ''); override;
|
||||||
|
public
|
||||||
|
constructor Create(ALogLevels: TX2LogLevels = X2LogLevelsDefault); overload;
|
||||||
|
constructor Create(AOnLog: TX2LogEvent; ALogLevels: TX2LogLevels = X2LogLevelsDefault); overload;
|
||||||
|
|
||||||
|
property OnLog: TX2LogEvent read FOnLog write FOnLog;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
|
||||||
|
{ TX2LogEventObserver }
|
||||||
|
constructor TX2LogEventObserver.Create(ALogLevels: TX2LogLevels);
|
||||||
|
begin
|
||||||
|
inherited Create(ALogLevels);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
constructor TX2LogEventObserver.Create(AOnLog: TX2LogEvent; ALogLevels: TX2LogLevels);
|
||||||
|
begin
|
||||||
|
Create(ALogLevels);
|
||||||
|
|
||||||
|
FOnLog := AOnLog;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogEventObserver.DoLog(ALevel: TX2LogLevel; const AMessage, ADetails: string);
|
||||||
|
begin
|
||||||
|
if Assigned(FOnLog) then
|
||||||
|
FOnLog(Self, ALevel, AMessage, ADetails);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
185
X2Log.Observer.LogFile.pas
Normal file
185
X2Log.Observer.LogFile.pas
Normal file
@ -0,0 +1,185 @@
|
|||||||
|
unit X2Log.Observer.LogFile;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
System.Classes,
|
||||||
|
System.Generics.Collections,
|
||||||
|
System.SyncObjs,
|
||||||
|
|
||||||
|
X2Log.Intf,
|
||||||
|
X2Log.Observer.Custom,
|
||||||
|
X2Log.Observer.CustomThreaded;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TX2LogFileObserver = class(TX2LogCustomThreadedObserver)
|
||||||
|
private
|
||||||
|
FFileName: string;
|
||||||
|
protected
|
||||||
|
function CreateWorkerThread: TX2LogObserverWorkerThread; override;
|
||||||
|
public
|
||||||
|
constructor Create(const AFileName: string; ALogLevels: TX2LogLevels = X2LogLevelsDefault);
|
||||||
|
constructor CreateInProgramData(const AFileName: string; ALogLevels: TX2LogLevels = X2LogLevelsDefault);
|
||||||
|
constructor CreateInUserAppData(const AFileName: string; ALogLevels: TX2LogLevels = X2LogLevelsDefault);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
System.IOUtils,
|
||||||
|
System.SysUtils,
|
||||||
|
System.Win.ComObj,
|
||||||
|
Winapi.SHFolder,
|
||||||
|
Winapi.Windows,
|
||||||
|
|
||||||
|
X2Log.Constants;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TX2LogFileWorkerThread = class(TX2LogObserverWorkerThread)
|
||||||
|
private
|
||||||
|
FFileName: string;
|
||||||
|
protected
|
||||||
|
procedure ProcessEntry(AEntry: TX2LogQueueEntry); override;
|
||||||
|
|
||||||
|
property FileName: string read FFileName;
|
||||||
|
public
|
||||||
|
constructor Create(const AFileName: string);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{ TX2LogFileObserver }
|
||||||
|
constructor TX2LogFileObserver.Create(const AFileName: string; ALogLevels: TX2LogLevels);
|
||||||
|
begin
|
||||||
|
FFileName := AFileName;
|
||||||
|
|
||||||
|
inherited Create(ALogLevels);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
constructor TX2LogFileObserver.CreateInProgramData(const AFileName: string; ALogLevels: TX2LogLevels);
|
||||||
|
var
|
||||||
|
path: PWideChar;
|
||||||
|
|
||||||
|
begin
|
||||||
|
GetMem(path, MAX_PATH);
|
||||||
|
try
|
||||||
|
OleCheck(SHGetFolderPath(0, CSIDL_COMMON_APPDATA, 0, SHGFP_TYPE_CURRENT, path));
|
||||||
|
Create(IncludeTrailingPathDelimiter(path) + AFileName, ALogLevels);
|
||||||
|
finally
|
||||||
|
FreeMem(path);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
constructor TX2LogFileObserver.CreateInUserAppData(const AFileName: string; ALogLevels: TX2LogLevels);
|
||||||
|
var
|
||||||
|
path: PWideChar;
|
||||||
|
|
||||||
|
begin
|
||||||
|
GetMem(path, MAX_PATH);
|
||||||
|
try
|
||||||
|
OleCheck(SHGetFolderPath(0, CSIDL_APPDATA, 0, SHGFP_TYPE_CURRENT, path));
|
||||||
|
Create(IncludeTrailingPathDelimiter(path) + AFileName, ALogLevels);
|
||||||
|
finally
|
||||||
|
FreeMem(path);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2LogFileObserver.CreateWorkerThread: TX2LogObserverWorkerThread;
|
||||||
|
begin
|
||||||
|
Result := TX2LogFileWorkerThread.Create(FFileName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TX2LogFileWorkerThread }
|
||||||
|
constructor TX2LogFileWorkerThread.Create(const AFileName: string);
|
||||||
|
begin
|
||||||
|
FFileName := AFileName;
|
||||||
|
|
||||||
|
inherited Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogFileWorkerThread.ProcessEntry(AEntry: TX2LogQueueEntry);
|
||||||
|
var
|
||||||
|
baseReportFileName: string;
|
||||||
|
errorMsg: string;
|
||||||
|
detailsExtension: string;
|
||||||
|
detailsFile: THandle;
|
||||||
|
detailsFileStream: THandleStream;
|
||||||
|
detailsWriter: TStreamWriter;
|
||||||
|
detailsFileName: string;
|
||||||
|
detailsNumber: Integer;
|
||||||
|
writer: TStreamWriter;
|
||||||
|
|
||||||
|
begin
|
||||||
|
ForceDirectories(ExtractFilePath(FileName));
|
||||||
|
errorMsg := AEntry.Message;
|
||||||
|
|
||||||
|
if Length(AEntry.Details) > 0 then
|
||||||
|
begin
|
||||||
|
detailsExtension := ExtractFileExt(FileName);
|
||||||
|
baseReportFileName := ChangeFileExt(FileName, '_' + FormatDateTime(GetLogResourceString(@LogFileNameDateFormat), Now));
|
||||||
|
detailsFileName := baseReportFileName + detailsExtension;
|
||||||
|
detailsNumber := 0;
|
||||||
|
|
||||||
|
if ForceDirectories(ExtractFilePath(detailsFileName)) then
|
||||||
|
begin
|
||||||
|
repeat
|
||||||
|
{ TFileStream lacks the ability to create a file only when it does not exist }
|
||||||
|
detailsFile := CreateFile(PChar(detailsFileName), GENERIC_READ or GENERIC_WRITE,
|
||||||
|
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, CREATE_NEW,
|
||||||
|
FILE_ATTRIBUTE_NORMAL, 0);
|
||||||
|
|
||||||
|
if detailsFile = INVALID_HANDLE_VALUE then
|
||||||
|
begin
|
||||||
|
if GetLastError = ERROR_FILE_EXISTS then
|
||||||
|
begin
|
||||||
|
{ Generate a new file name }
|
||||||
|
Inc(detailsNumber);
|
||||||
|
detailsFileName := Format('%s_%d%s', [baseReportFileName, detailsNumber,
|
||||||
|
detailsExtension]);
|
||||||
|
end else
|
||||||
|
break;
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
{ Details file succesfully generated }
|
||||||
|
try
|
||||||
|
detailsFileStream := THandleStream.Create(detailsFile);
|
||||||
|
try
|
||||||
|
detailsWriter := TStreamWriter.Create(detailsFileStream, TEncoding.ANSI);
|
||||||
|
try
|
||||||
|
detailsWriter.Write(AEntry.Details);
|
||||||
|
finally
|
||||||
|
FreeAndNil(detailsWriter);
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
FreeAndNil(detailsFileStream);
|
||||||
|
end;
|
||||||
|
finally
|
||||||
|
CloseHandle(detailsFile);
|
||||||
|
end;
|
||||||
|
|
||||||
|
// ErrorLogs.Add(reportFileName);
|
||||||
|
|
||||||
|
errorMsg := errorMsg + Format(GetLogResourceString(@LogFileLineDetails), [ExtractFileName(detailsFileName)]);
|
||||||
|
break;
|
||||||
|
end;
|
||||||
|
until False;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ Append line to log file }
|
||||||
|
writer := TFile.AppendText(FileName);
|
||||||
|
try
|
||||||
|
writer.WriteLine('[' + FormatDateTime(GetLogResourceString(@LogFileLineDateFormat), Now) + '] ' +
|
||||||
|
GetLogLevelText(AEntry.Level) + ': ' + errorMsg);
|
||||||
|
finally
|
||||||
|
FreeAndNil(writer);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
422
X2Log.Observer.NamedPipe.pas
Normal file
422
X2Log.Observer.NamedPipe.pas
Normal file
@ -0,0 +1,422 @@
|
|||||||
|
unit X2Log.Observer.NamedPipe;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
X2Log.Intf,
|
||||||
|
X2Log.Observer.Custom,
|
||||||
|
X2Log.Observer.CustomThreaded;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TX2LogNamedPipeObserver = class(TX2LogCustomThreadedObserver)
|
||||||
|
private
|
||||||
|
FPipeName: string;
|
||||||
|
protected
|
||||||
|
function CreateWorkerThread: TX2LogObserverWorkerThread; override;
|
||||||
|
public
|
||||||
|
constructor Create(const APipeName: string; ALogLevels: TX2LogLevels = X2LogLevelsDefault);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
System.Generics.Collections,
|
||||||
|
System.SyncObjs,
|
||||||
|
System.SysUtils,
|
||||||
|
Winapi.Windows;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
EX2LogSilentException = class(Exception);
|
||||||
|
EX2LogPipeDisconnected = class(EX2LogSilentException);
|
||||||
|
|
||||||
|
TX2LogNamedPipeClientState = (Listening, Connected, Writing);
|
||||||
|
|
||||||
|
TX2LogNamedPipeClient = class(TObject)
|
||||||
|
private
|
||||||
|
FOverlapped: TOverlapped;
|
||||||
|
FPipe: THandle;
|
||||||
|
FState: TX2LogNamedPipeClientState;
|
||||||
|
FOverlappedEvent: TEvent;
|
||||||
|
FWriteQueue: TObjectQueue<TX2LogQueueEntry>;
|
||||||
|
FWriteBuffer: Pointer;
|
||||||
|
FWriteBufferSize: Integer;
|
||||||
|
protected
|
||||||
|
function DoSend(AEntry: TX2LogQueueEntry): Boolean;
|
||||||
|
procedure ClearWriteBuffer;
|
||||||
|
public
|
||||||
|
constructor Create(APipe: THandle);
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
procedure Send(AEntry: TX2LogQueueEntry);
|
||||||
|
procedure SendNext;
|
||||||
|
|
||||||
|
procedure Disconnect;
|
||||||
|
|
||||||
|
property Pipe: THandle read FPipe;
|
||||||
|
property Overlapped: TOverlapped read FOverlapped;
|
||||||
|
property OverlappedEvent: TEvent read FOverlappedEvent;
|
||||||
|
property State: TX2LogNamedPipeClientState read FState write FState;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TX2LogNamedPipeWorkerThread = class(TX2LogObserverWorkerThread)
|
||||||
|
private
|
||||||
|
FClients: TObjectList<TX2LogNamedPipeClient>;
|
||||||
|
FPipeName: string;
|
||||||
|
protected
|
||||||
|
|
||||||
|
procedure WaitForEntry; override;
|
||||||
|
procedure ProcessEntry(AEntry: TX2LogQueueEntry); override;
|
||||||
|
procedure ProcessClientEvent(AClientIndex: Integer);
|
||||||
|
|
||||||
|
procedure AddListener;
|
||||||
|
procedure RemoveClient(AClientIndex: Integer);
|
||||||
|
procedure Setup; override;
|
||||||
|
procedure Cleanup; override;
|
||||||
|
|
||||||
|
property Clients: TObjectList<TX2LogNamedPipeClient> read FClients;
|
||||||
|
property PipeName: string read FPipeName;
|
||||||
|
public
|
||||||
|
constructor Create(const APipeName: string);
|
||||||
|
destructor Destroy; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TX2LogNamedPipeObserver }
|
||||||
|
constructor TX2LogNamedPipeObserver.Create(const APipeName: string; ALogLevels: TX2LogLevels);
|
||||||
|
begin
|
||||||
|
FPipeName := APipeName;
|
||||||
|
|
||||||
|
inherited Create(ALogLevels);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2LogNamedPipeObserver.CreateWorkerThread: TX2LogObserverWorkerThread;
|
||||||
|
begin
|
||||||
|
Result := TX2LogNamedPipeWorkerThread.Create(FPipeName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TX2LogNamedPipeClient }
|
||||||
|
constructor TX2LogNamedPipeClient.Create(APipe: THandle);
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
|
||||||
|
FPipe := APipe;
|
||||||
|
FState := Listening;
|
||||||
|
|
||||||
|
FOverlappedEvent := TEvent.Create(nil, False, False, '');
|
||||||
|
FOverlapped.hEvent := FOverlappedEvent.Handle;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
destructor TX2LogNamedPipeClient.Destroy;
|
||||||
|
begin
|
||||||
|
FreeAndNil(FOverlappedEvent);
|
||||||
|
|
||||||
|
if FPipe <> INVALID_HANDLE_VALUE then
|
||||||
|
DisconnectNamedPipe(FPipe);
|
||||||
|
|
||||||
|
ClearWriteBuffer;
|
||||||
|
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogNamedPipeClient.Send(AEntry: TX2LogQueueEntry);
|
||||||
|
begin
|
||||||
|
if not Assigned(FWriteBuffer) then
|
||||||
|
DoSend(AEntry)
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if not Assigned(FWriteQueue) then
|
||||||
|
FWriteQueue := TObjectQueue<TX2LogQueueEntry>.Create(True);
|
||||||
|
|
||||||
|
FWriteQueue.Enqueue(TX2LogQueueEntry.Create(AEntry));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogNamedPipeClient.SendNext;
|
||||||
|
var
|
||||||
|
entry: TX2LogQueueEntry;
|
||||||
|
|
||||||
|
begin
|
||||||
|
ClearWriteBuffer;
|
||||||
|
|
||||||
|
while FWriteQueue.Count > 0 do
|
||||||
|
begin
|
||||||
|
entry := FWriteQueue.Extract;
|
||||||
|
try
|
||||||
|
{ Returns False when IO is pending }
|
||||||
|
if not DoSend(entry) then
|
||||||
|
break;
|
||||||
|
finally
|
||||||
|
FreeAndNil(entry);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogNamedPipeClient.Disconnect;
|
||||||
|
begin
|
||||||
|
if FPipe <> INVALID_HANDLE_VALUE then
|
||||||
|
begin
|
||||||
|
CancelIo(FPipe);
|
||||||
|
DisconnectNamedPipe(FPipe);
|
||||||
|
|
||||||
|
FPipe := INVALID_HANDLE_VALUE;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2LogNamedPipeClient.DoSend(AEntry: TX2LogQueueEntry): Boolean;
|
||||||
|
|
||||||
|
procedure AppendToBuffer(var APointer: PByte; const ASource; ASize: Cardinal); overload; inline;
|
||||||
|
begin
|
||||||
|
Move(ASource, APointer^, ASize);
|
||||||
|
Inc(APointer, ASize);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure AppendToBuffer(var APointer: PByte; const ASource: string); overload; inline;
|
||||||
|
var
|
||||||
|
sourceLength: Cardinal;
|
||||||
|
|
||||||
|
begin
|
||||||
|
sourceLength := Length(ASource);
|
||||||
|
AppendToBuffer(APointer, sourceLength, SizeOf(Cardinal));
|
||||||
|
AppendToBuffer(APointer, PChar(ASource)^, sourceLength * SizeOf(Char));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
var
|
||||||
|
bytesWritten: Cardinal;
|
||||||
|
bufferPointer: PByte;
|
||||||
|
lastError: Cardinal;
|
||||||
|
|
||||||
|
begin
|
||||||
|
ClearWriteBuffer;
|
||||||
|
|
||||||
|
FWriteBufferSize := SizeOf(TX2LogLevel) +
|
||||||
|
SizeOf(Cardinal) + (Length(AEntry.Message) * SizeOf(Char)) +
|
||||||
|
SizeOf(Cardinal) + (Length(AEntry.Details) * SizeOf(Char));
|
||||||
|
|
||||||
|
GetMem(FWriteBuffer, FWriteBufferSize);
|
||||||
|
|
||||||
|
bufferPointer := FWriteBuffer;
|
||||||
|
AppendToBuffer(bufferPointer, AEntry.Level, SizeOf(TX2LogLevel));
|
||||||
|
AppendToBuffer(bufferPointer, AEntry.Message);
|
||||||
|
AppendToBuffer(bufferPointer, AEntry.Details);
|
||||||
|
|
||||||
|
Result := WriteFile(Pipe, FWriteBuffer^, FWriteBufferSize, bytesWritten, @Overlapped);
|
||||||
|
if not Result then
|
||||||
|
begin
|
||||||
|
lastError := GetLastError;
|
||||||
|
if lastError in [ERROR_NO_DATA, ERROR_PIPE_NOT_CONNECTED] then
|
||||||
|
raise EX2LogPipeDisconnected.Create('Client disconnected');
|
||||||
|
|
||||||
|
if lastError = ERROR_IO_PENDING then
|
||||||
|
State := Writing
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
ClearWriteBuffer;
|
||||||
|
RaiseLastOSError;
|
||||||
|
end;
|
||||||
|
end else
|
||||||
|
begin
|
||||||
|
ClearWriteBuffer;
|
||||||
|
State := Connected;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogNamedPipeClient.ClearWriteBuffer;
|
||||||
|
begin
|
||||||
|
if Assigned(FWriteBuffer) then
|
||||||
|
begin
|
||||||
|
FreeMem(FWriteBuffer, FWriteBufferSize);
|
||||||
|
FWriteBuffer := nil;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{ TX2LogNamedPipeWorkerThread }
|
||||||
|
constructor TX2LogNamedPipeWorkerThread.Create(const APipeName: string);
|
||||||
|
begin
|
||||||
|
FPipeName := APipeName;
|
||||||
|
FClients := TObjectList<TX2LogNamedPipeClient>.Create(True);
|
||||||
|
|
||||||
|
inherited Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
destructor TX2LogNamedPipeWorkerThread.Destroy;
|
||||||
|
begin
|
||||||
|
inherited Destroy;
|
||||||
|
|
||||||
|
FreeAndNil(FClients);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogNamedPipeWorkerThread.Setup;
|
||||||
|
begin
|
||||||
|
inherited Setup;
|
||||||
|
|
||||||
|
AddListener;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogNamedPipeWorkerThread.Cleanup;
|
||||||
|
var
|
||||||
|
client: TX2LogNamedPipeClient;
|
||||||
|
|
||||||
|
begin
|
||||||
|
for client in Clients do
|
||||||
|
client.Disconnect;
|
||||||
|
|
||||||
|
inherited Cleanup;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogNamedPipeWorkerThread.WaitForEntry;
|
||||||
|
var
|
||||||
|
eventHandles: array of THandle;
|
||||||
|
clientIndex: Integer;
|
||||||
|
waitResult: Cardinal;
|
||||||
|
|
||||||
|
begin
|
||||||
|
repeat
|
||||||
|
SetLength(eventHandles, Clients.Count + 1);
|
||||||
|
for clientIndex := 0 to Pred(Clients.Count) do
|
||||||
|
eventHandles[clientIndex] := Clients[clientIndex].OverlappedEvent.Handle;
|
||||||
|
|
||||||
|
eventHandles[Clients.Count] := LogQueueSignal.Handle;
|
||||||
|
|
||||||
|
waitResult := WaitForMultipleObjects(Length(eventHandles), @eventHandles[0], False, INFINITE);
|
||||||
|
if waitResult in [WAIT_OBJECT_0..WAIT_OBJECT_0 + Pred(High(eventHandles))] then
|
||||||
|
begin
|
||||||
|
{ Connect or write I/O completed }
|
||||||
|
clientIndex := waitResult - WAIT_OBJECT_0;
|
||||||
|
if (clientIndex >= 0) and (clientIndex < Clients.Count) then
|
||||||
|
ProcessClientEvent(clientIndex);
|
||||||
|
end else if waitResult = Cardinal(WAIT_OBJECT_0 + High(eventHandles)) then
|
||||||
|
begin
|
||||||
|
{ Entry queued }
|
||||||
|
break;
|
||||||
|
end else if waitResult in [WAIT_ABANDONED_0..WAIT_ABANDONED_0 + High(eventHandles)] then
|
||||||
|
begin
|
||||||
|
{ Client event abandoned }
|
||||||
|
clientIndex := waitResult - WAIT_ABANDONED_0;
|
||||||
|
if (clientIndex >= 0) and (clientIndex < Clients.Count) then
|
||||||
|
RemoveClient(clientIndex)
|
||||||
|
else if clientIndex = Clients.Count then
|
||||||
|
Terminate;
|
||||||
|
end else if waitResult = WAIT_FAILED then
|
||||||
|
RaiseLastOSError;
|
||||||
|
until False;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogNamedPipeWorkerThread.ProcessEntry(AEntry: TX2LogQueueEntry);
|
||||||
|
var
|
||||||
|
clientIndex: Integer;
|
||||||
|
client: TX2LogNamedPipeClient;
|
||||||
|
|
||||||
|
begin
|
||||||
|
{ Broadcast to connected clients }
|
||||||
|
for clientIndex := Pred(Clients.Count) downto 0 do
|
||||||
|
begin
|
||||||
|
client := Clients[clientIndex];
|
||||||
|
|
||||||
|
if client.State <> Listening then
|
||||||
|
try
|
||||||
|
client.Send(AEntry);
|
||||||
|
except
|
||||||
|
on E:EX2LogPipeDisconnected do
|
||||||
|
RemoveClient(clientIndex);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogNamedPipeWorkerThread.ProcessClientEvent(AClientIndex: Integer);
|
||||||
|
var
|
||||||
|
client: TX2LogNamedPipeClient;
|
||||||
|
bytesTransferred: Cardinal;
|
||||||
|
|
||||||
|
begin
|
||||||
|
client := Clients[AClientIndex];
|
||||||
|
|
||||||
|
case client.State of
|
||||||
|
Listening:
|
||||||
|
{ Client connected }
|
||||||
|
if GetOverlappedResult(client.Pipe, client.Overlapped, bytesTransferred, False) then
|
||||||
|
begin
|
||||||
|
client.State := Connected;
|
||||||
|
AddListener;
|
||||||
|
end else
|
||||||
|
RemoveClient(AClientIndex);
|
||||||
|
|
||||||
|
Writing:
|
||||||
|
{ Write operation completed }
|
||||||
|
if GetOverlappedResult(client.Pipe, client.Overlapped, bytesTransferred, False) and
|
||||||
|
(bytesTransferred > 0) then
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
client.SendNext;
|
||||||
|
except
|
||||||
|
on E:EX2LogPipeDisconnected do
|
||||||
|
RemoveClient(AClientIndex);
|
||||||
|
end;
|
||||||
|
end else
|
||||||
|
RemoveClient(AClientIndex);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogNamedPipeWorkerThread.AddListener;
|
||||||
|
const
|
||||||
|
BufferSize = 4096;
|
||||||
|
DefaultTimeout = 5000;
|
||||||
|
|
||||||
|
var
|
||||||
|
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);
|
||||||
|
|
||||||
|
if pipe <> INVALID_HANDLE_VALUE then
|
||||||
|
begin
|
||||||
|
client := TX2LogNamedPipeClient.Create(pipe);
|
||||||
|
|
||||||
|
if not ConnectNamedPipe(client.Pipe, @client.Overlapped) then
|
||||||
|
begin
|
||||||
|
case GetLastError of
|
||||||
|
ERROR_IO_PENDING:
|
||||||
|
Clients.Add(client);
|
||||||
|
|
||||||
|
ERROR_PIPE_CONNECTED:
|
||||||
|
begin
|
||||||
|
client.State := Connected;
|
||||||
|
Clients.Add(client);
|
||||||
|
end;
|
||||||
|
else
|
||||||
|
{ Error occured }
|
||||||
|
FreeAndNil(client);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2LogNamedPipeWorkerThread.RemoveClient(AClientIndex: Integer);
|
||||||
|
begin
|
||||||
|
Clients.Delete(AClientIndex);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
48
X2Log.groupproj
Normal file
48
X2Log.groupproj
Normal file
@ -0,0 +1,48 @@
|
|||||||
|
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||||
|
<PropertyGroup>
|
||||||
|
<ProjectGuid>{66C17964-1E71-4A50-A5F4-D04EB6A833D3}</ProjectGuid>
|
||||||
|
</PropertyGroup>
|
||||||
|
<ItemGroup>
|
||||||
|
<Projects Include="Test\X2LogTest.dproj">
|
||||||
|
<Dependencies/>
|
||||||
|
</Projects>
|
||||||
|
<Projects Include="NamedPipeClient\X2LogNamedPipeClient.dproj">
|
||||||
|
<Dependencies/>
|
||||||
|
</Projects>
|
||||||
|
</ItemGroup>
|
||||||
|
<ProjectExtensions>
|
||||||
|
<Borland.Personality>Default.Personality.12</Borland.Personality>
|
||||||
|
<Borland.ProjectType/>
|
||||||
|
<BorlandProject>
|
||||||
|
<Default.Personality/>
|
||||||
|
</BorlandProject>
|
||||||
|
</ProjectExtensions>
|
||||||
|
<Target Name="X2LogTest">
|
||||||
|
<MSBuild Projects="Test\X2LogTest.dproj"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="X2LogTest:Clean">
|
||||||
|
<MSBuild Projects="Test\X2LogTest.dproj" Targets="Clean"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="X2LogTest:Make">
|
||||||
|
<MSBuild Projects="Test\X2LogTest.dproj" Targets="Make"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="X2LogNamedPipeClient">
|
||||||
|
<MSBuild Projects="NamedPipeClient\X2LogNamedPipeClient.dproj"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="X2LogNamedPipeClient:Clean">
|
||||||
|
<MSBuild Projects="NamedPipeClient\X2LogNamedPipeClient.dproj" Targets="Clean"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="X2LogNamedPipeClient:Make">
|
||||||
|
<MSBuild Projects="NamedPipeClient\X2LogNamedPipeClient.dproj" Targets="Make"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="Build">
|
||||||
|
<CallTarget Targets="X2LogTest;X2LogNamedPipeClient"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="Clean">
|
||||||
|
<CallTarget Targets="X2LogTest:Clean;X2LogNamedPipeClient:Clean"/>
|
||||||
|
</Target>
|
||||||
|
<Target Name="Make">
|
||||||
|
<CallTarget Targets="X2LogTest:Make;X2LogNamedPipeClient:Make"/>
|
||||||
|
</Target>
|
||||||
|
<Import Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')" Project="$(BDS)\Bin\CodeGear.Group.Targets"/>
|
||||||
|
</Project>
|
||||||
134
X2Log.pas
Normal file
134
X2Log.pas
Normal file
@ -0,0 +1,134 @@
|
|||||||
|
unit X2Log;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
System.Classes,
|
||||||
|
System.Generics.Collections,
|
||||||
|
System.SysUtils,
|
||||||
|
|
||||||
|
X2Log.Intf;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TX2Log = class(TInterfacedObject, IX2Log, IX2LogMethods)
|
||||||
|
private
|
||||||
|
FExceptionStrategy: IX2LogExceptionStrategy;
|
||||||
|
FObservers: TList<IX2LogObserver>;
|
||||||
|
private
|
||||||
|
property ExceptionStrategy: IX2LogExceptionStrategy read FExceptionStrategy;
|
||||||
|
property Observers: TList<IX2LogObserver> read FObservers;
|
||||||
|
public
|
||||||
|
constructor Create;
|
||||||
|
destructor Destroy; override;
|
||||||
|
|
||||||
|
{ IX2Log }
|
||||||
|
procedure Attach(AObserver: IX2LogObserver);
|
||||||
|
procedure Detach(AObserver: IX2LogObserver);
|
||||||
|
|
||||||
|
procedure SetExceptionStrategy(AStrategy: IX2LogExceptionStrategy);
|
||||||
|
|
||||||
|
{ IX2LogMethods }
|
||||||
|
procedure Log(ALevel: TX2LogLevel; const AMessage: string; const ADetails: string = '');
|
||||||
|
|
||||||
|
procedure Verbose(const AMessage: string; const ADetails: string = '');
|
||||||
|
procedure Info(const AMessage: string; const ADetails: string = '');
|
||||||
|
procedure Warning(const AMessage: string; const ADetails: string = '');
|
||||||
|
procedure Error(const AMessage: string; const ADetails: string = '');
|
||||||
|
procedure Exception(AException: Exception; const AMessage: string = ''; const ADetails: string = '');
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
X2Log.Exception.Default;
|
||||||
|
|
||||||
|
|
||||||
|
{ TX2Log }
|
||||||
|
constructor TX2Log.Create;
|
||||||
|
begin
|
||||||
|
inherited Create;
|
||||||
|
|
||||||
|
FObservers := TList<IX2LogObserver>.Create;
|
||||||
|
SetExceptionStrategy(nil);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
destructor TX2Log.Destroy;
|
||||||
|
begin
|
||||||
|
FreeAndNil(FObservers);
|
||||||
|
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2Log.Attach(AObserver: IX2LogObserver);
|
||||||
|
begin
|
||||||
|
{ Explicit cast ensures we're getting the same pointer in Attach and Detach
|
||||||
|
if, for example, the implementing interface is a descendant of IX2LogObserver }
|
||||||
|
Observers.Add(AObserver as IX2LogObserver);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2Log.Detach(AObserver: IX2LogObserver);
|
||||||
|
begin
|
||||||
|
Observers.Remove(AObserver as IX2LogObserver);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2Log.SetExceptionStrategy(AStrategy: IX2LogExceptionStrategy);
|
||||||
|
begin
|
||||||
|
if Assigned(AStrategy) then
|
||||||
|
FExceptionStrategy := AStrategy
|
||||||
|
else
|
||||||
|
FExceptionStrategy := TX2LogDefaultExceptionStrategy.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2Log.Log(ALevel: TX2LogLevel; const AMessage, ADetails: string);
|
||||||
|
var
|
||||||
|
observer: IX2LogObserver;
|
||||||
|
|
||||||
|
begin
|
||||||
|
for observer in Observers do
|
||||||
|
observer.Log(ALevel, AMessage, ADetails);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2Log.Verbose(const AMessage, ADetails: string);
|
||||||
|
begin
|
||||||
|
Log(TX2LogLevel.Verbose, AMessage, ADetails);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2Log.Info(const AMessage, ADetails: string);
|
||||||
|
begin
|
||||||
|
Log(TX2LogLevel.Info, AMessage, ADetails);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2Log.Warning(const AMessage, ADetails: string);
|
||||||
|
begin
|
||||||
|
Log(TX2LogLevel.Warning, AMessage, ADetails);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2Log.Error(const AMessage, ADetails: string);
|
||||||
|
begin
|
||||||
|
Log(TX2LogLevel.Error, AMessage, ADetails);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2Log.Exception(AException: Exception; const AMessage, ADetails: string);
|
||||||
|
var
|
||||||
|
msg: string;
|
||||||
|
details: string;
|
||||||
|
|
||||||
|
begin
|
||||||
|
msg := AMessage;
|
||||||
|
details := ADetails;
|
||||||
|
|
||||||
|
ExceptionStrategy.Execute(AException, msg, details);
|
||||||
|
Log(TX2LogLevel.Error, msg, details);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
Loading…
Reference in New Issue
Block a user