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