Added: PersistXML implementation
This commit is contained in:
parent
6ec85cfb1f
commit
f406555e55
@ -30,7 +30,30 @@ package X2Utils;
|
|||||||
requires
|
requires
|
||||||
rtl,
|
rtl,
|
||||||
vcl,
|
vcl,
|
||||||
vclx;
|
vclx,
|
||||||
|
xmlrtl,
|
||||||
|
unaGeneralD2007,
|
||||||
|
IndyProtocols,
|
||||||
|
IndyCore,
|
||||||
|
IndySystem,
|
||||||
|
cxExportD11,
|
||||||
|
cxLibraryD11,
|
||||||
|
dxThemeD11,
|
||||||
|
dxGDIPlusD11,
|
||||||
|
dxCoreD11,
|
||||||
|
dbrtl,
|
||||||
|
vcldb,
|
||||||
|
vcljpg,
|
||||||
|
cxEditorsD11,
|
||||||
|
cxDataD11,
|
||||||
|
cxExtEditorsD11,
|
||||||
|
cxPageControlD11,
|
||||||
|
cxGridD11,
|
||||||
|
inet,
|
||||||
|
madExcept_,
|
||||||
|
madDisAsm_,
|
||||||
|
madBasic_,
|
||||||
|
dsnap;
|
||||||
|
|
||||||
contains
|
contains
|
||||||
X2UtApp in '..\..\X2UtApp.pas',
|
X2UtApp in '..\..\X2UtApp.pas',
|
||||||
@ -53,6 +76,8 @@ contains
|
|||||||
X2UtPersistForm in '..\..\X2UtPersistForm.pas',
|
X2UtPersistForm in '..\..\X2UtPersistForm.pas',
|
||||||
X2UtPersistIntf in '..\..\X2UtPersistIntf.pas',
|
X2UtPersistIntf in '..\..\X2UtPersistIntf.pas',
|
||||||
X2UtPersistRegistry in '..\..\X2UtPersistRegistry.pas',
|
X2UtPersistRegistry in '..\..\X2UtPersistRegistry.pas',
|
||||||
X2UtElevation in '..\..\X2UtElevation.pas';
|
X2UtElevation in '..\..\X2UtElevation.pas',
|
||||||
|
X2UtPersistXML in '..\..\X2UtPersistXML.pas',
|
||||||
|
X2UtPersistXMLBinding in '..\..\X2UtPersistXMLBinding.pas';
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
@ -1,11 +1,12 @@
|
|||||||
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
<?xml version="1.0" encoding="utf-8"?>
|
||||||
|
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
|
||||||
<PropertyGroup>
|
<PropertyGroup>
|
||||||
<ProjectGuid>{3cd28184-f9a5-4320-9ad8-80ef25ba762e}</ProjectGuid>
|
<ProjectGuid>{3cd28184-f9a5-4320-9ad8-80ef25ba762e}</ProjectGuid>
|
||||||
<MainSource>X2Utils.dpk</MainSource>
|
<MainSource>X2Utils.dpk</MainSource>
|
||||||
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
|
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
|
||||||
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
|
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
|
||||||
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
|
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
|
||||||
<DCC_DependencyCheckOutputName>..\..\..\bpl\D2006\X2Utils2007.bpl</DCC_DependencyCheckOutputName>
|
<DCC_DependencyCheckOutputName>%DELPHIBIN%\X2Utils2007.bpl</DCC_DependencyCheckOutputName>
|
||||||
</PropertyGroup>
|
</PropertyGroup>
|
||||||
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
|
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
|
||||||
<Version>7.0</Version>
|
<Version>7.0</Version>
|
||||||
@ -32,6 +33,26 @@
|
|||||||
<BorlandProject>
|
<BorlandProject>
|
||||||
<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><Package_Options><Package_Options Name="PackageDescription">X2Utils</Package_Options><Package_Options Name="ImplicitBuild">True</Package_Options><Package_Options Name="DesigntimeOnly">False</Package_Options><Package_Options Name="RuntimeOnly">True</Package_Options><Package_Options Name="LibSuffix">2007</Package_Options></Package_Options><VersionInfo><VersionInfo Name="IncludeVerInfo">True</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><VersionInfoKeys Name="FileDescription"></VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">X2Utils.dpk</Source></Source><Excluded_Packages>
|
<BorlandProject><Delphi.Personality><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><Package_Options><Package_Options Name="PackageDescription">X2Utils</Package_Options><Package_Options Name="ImplicitBuild">True</Package_Options><Package_Options Name="DesigntimeOnly">False</Package_Options><Package_Options Name="RuntimeOnly">True</Package_Options><Package_Options Name="LibSuffix">2007</Package_Options></Package_Options><VersionInfo><VersionInfo Name="IncludeVerInfo">True</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><VersionInfoKeys Name="FileDescription"></VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">X2Utils.dpk</Source></Source><Excluded_Packages>
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
<Excluded_Packages Name="$(BDS)\bin\dcloffice2k100.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
|
<Excluded_Packages Name="$(BDS)\bin\dcloffice2k100.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
|
||||||
<Excluded_Packages Name="$(BDS)\bin\dclofficexp100.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
|
<Excluded_Packages Name="$(BDS)\bin\dclofficexp100.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
|
||||||
@ -42,9 +63,6 @@
|
|||||||
<DelphiCompile Include="X2Utils.dpk">
|
<DelphiCompile Include="X2Utils.dpk">
|
||||||
<MainSource>MainSource</MainSource>
|
<MainSource>MainSource</MainSource>
|
||||||
</DelphiCompile>
|
</DelphiCompile>
|
||||||
<DCCReference Include="$(SystemRoot)\system32\VirtualTreesD207.dcp" />
|
|
||||||
<DCCReference Include="$(SystemRoot)\system32\VirtualTreesD27.dcp" />
|
|
||||||
<DCCReference Include="$(SystemRoot)\system32\VirtualTreesD7.dcp" />
|
|
||||||
<DCCReference Include="..\..\X2UtApp.pas" />
|
<DCCReference Include="..\..\X2UtApp.pas" />
|
||||||
<DCCReference Include="..\..\X2UtBits.pas" />
|
<DCCReference Include="..\..\X2UtBits.pas" />
|
||||||
<DCCReference Include="..\..\X2UtElevation.pas" />
|
<DCCReference Include="..\..\X2UtElevation.pas" />
|
||||||
@ -61,13 +79,38 @@
|
|||||||
<DCCReference Include="..\..\X2UtPersistForm.pas" />
|
<DCCReference Include="..\..\X2UtPersistForm.pas" />
|
||||||
<DCCReference Include="..\..\X2UtPersistIntf.pas" />
|
<DCCReference Include="..\..\X2UtPersistIntf.pas" />
|
||||||
<DCCReference Include="..\..\X2UtPersistRegistry.pas" />
|
<DCCReference Include="..\..\X2UtPersistRegistry.pas" />
|
||||||
|
<DCCReference Include="..\..\X2UtPersistXML.pas" />
|
||||||
|
<DCCReference Include="..\..\X2UtPersistXMLBinding.pas" />
|
||||||
<DCCReference Include="..\..\X2UtProcess.pas" />
|
<DCCReference Include="..\..\X2UtProcess.pas" />
|
||||||
<DCCReference Include="..\..\X2UtSingleInstance.pas" />
|
<DCCReference Include="..\..\X2UtSingleInstance.pas" />
|
||||||
<DCCReference Include="..\..\X2UtStreams.pas" />
|
<DCCReference Include="..\..\X2UtStreams.pas" />
|
||||||
<DCCReference Include="..\..\X2UtStrings.pas" />
|
<DCCReference Include="..\..\X2UtStrings.pas" />
|
||||||
<DCCReference Include="..\..\X2UtTempFile.pas" />
|
<DCCReference Include="..\..\X2UtTempFile.pas" />
|
||||||
<DCCReference Include="F:\Development\X2FileShare\Source\UAC\rtl.dcp" />
|
<DCCReference Include="C:\Projects\backup\cxDataD11.dcp" />
|
||||||
<DCCReference Include="F:\Development\X2FileShare\Source\UAC\vcl.dcp" />
|
<DCCReference Include="C:\Projects\backup\cxEditorsD11.dcp" />
|
||||||
<DCCReference Include="F:\Development\X2FileShare\Source\UAC\vclx.dcp" />
|
<DCCReference Include="C:\Projects\backup\cxExportD11.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\cxExtEditorsD11.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\cxGridD11.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\cxLibraryD11.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\cxPageControlD11.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\dbrtl.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\dsnap.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\dxCoreD11.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\dxGDIPlusD11.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\dxThemeD11.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\IndyCore.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\IndyProtocols.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\IndySystem.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\inet.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\madBasic_.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\madDisAsm_.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\madExcept_.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\rtl.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\unaGeneralD2007.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\vcl.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\vcldb.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\vcljpg.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\vclx.dcp" />
|
||||||
|
<DCCReference Include="C:\Projects\backup\xmlrtl.dcp" />
|
||||||
</ItemGroup>
|
</ItemGroup>
|
||||||
</Project>
|
</Project>
|
371
X2UtPersistXML.pas
Normal file
371
X2UtPersistXML.pas
Normal file
@ -0,0 +1,371 @@
|
|||||||
|
{
|
||||||
|
:: X2UtPersistXML implements persistency to an XML file.
|
||||||
|
::
|
||||||
|
:: Last changed: $Date$
|
||||||
|
:: Revision: $Rev$
|
||||||
|
:: Author: $Author$
|
||||||
|
}
|
||||||
|
unit X2UtPersistXML;
|
||||||
|
|
||||||
|
{$WARN SYMBOL_PLATFORM OFF}
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
Classes,
|
||||||
|
Registry,
|
||||||
|
Windows,
|
||||||
|
|
||||||
|
X2UtPersist,
|
||||||
|
X2UtPersistIntf,
|
||||||
|
X2UtPersistXMLBinding;
|
||||||
|
|
||||||
|
|
||||||
|
type
|
||||||
|
TX2UtPersistXML = class(TX2CustomPersist)
|
||||||
|
private
|
||||||
|
FFileName: String;
|
||||||
|
protected
|
||||||
|
function CreateFiler(AIsReader: Boolean): IX2PersistFiler; override;
|
||||||
|
public
|
||||||
|
property FileName: String read FFileName write FFileName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
TX2UtPersistXMLFiler = class(TX2CustomPersistFiler)
|
||||||
|
private
|
||||||
|
FFileName: String;
|
||||||
|
FConfiguration: IXMLConfiguration;
|
||||||
|
FSection: IXMLSection;
|
||||||
|
FSectionStack: TInterfaceList;
|
||||||
|
protected
|
||||||
|
function ReadValue(const AName: string; out AValue: string): Boolean;
|
||||||
|
function WriteValue(const AName: string; const AValue: string): Boolean;
|
||||||
|
public
|
||||||
|
function BeginSection(const AName: String): Boolean; override;
|
||||||
|
procedure EndSection; override;
|
||||||
|
|
||||||
|
|
||||||
|
procedure GetKeys(const ADest: TStrings); override;
|
||||||
|
procedure GetSections(const ADest: TStrings); override;
|
||||||
|
|
||||||
|
|
||||||
|
function ReadInteger(const AName: String; out AValue: Integer): Boolean; override;
|
||||||
|
function ReadFloat(const AName: String; out AValue: Extended): Boolean; override;
|
||||||
|
function ReadString(const AName: String; out AValue: String): Boolean; override;
|
||||||
|
function ReadInt64(const AName: String; out AValue: Int64): Boolean; override;
|
||||||
|
|
||||||
|
function ReadStream(const AName: string; AStream: TStream): Boolean; override;
|
||||||
|
|
||||||
|
|
||||||
|
function WriteInteger(const AName: String; AValue: Integer): Boolean; override;
|
||||||
|
function WriteFloat(const AName: String; AValue: Extended): Boolean; override;
|
||||||
|
function WriteString(const AName, AValue: String): Boolean; override;
|
||||||
|
function WriteInt64(const AName: String; AValue: Int64): Boolean; override;
|
||||||
|
|
||||||
|
function WriteStream(const AName: string; AStream: TStream): Boolean; override;
|
||||||
|
|
||||||
|
procedure DeleteKey(const AName: string); override;
|
||||||
|
procedure DeleteSection(const AName: string); override;
|
||||||
|
|
||||||
|
|
||||||
|
property Configuration: IXMLConfiguration read FConfiguration;
|
||||||
|
property Section: IXMLSection read FSection;
|
||||||
|
property SectionStack: TInterfaceList read FSectionStack;
|
||||||
|
property FileName: String read FFileName;
|
||||||
|
public
|
||||||
|
constructor Create(AIsReader: Boolean; const AFileName: String);
|
||||||
|
destructor Destroy; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Wrapper functions }
|
||||||
|
function ReadFromXML(AObject: TObject; const AFileName: string): Boolean;
|
||||||
|
procedure WriteToXML(AObject: TObject; const AFileName: string);
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
SysUtils,
|
||||||
|
|
||||||
|
X2UtStrings;
|
||||||
|
|
||||||
|
|
||||||
|
const
|
||||||
|
RegistrySeparator = '\';
|
||||||
|
|
||||||
|
|
||||||
|
{ Wrapper functions }
|
||||||
|
function ReadFromXML(AObject: TObject; const AFileName: string): Boolean;
|
||||||
|
begin
|
||||||
|
with TX2UtPersistXML.Create do
|
||||||
|
try
|
||||||
|
FileName := AFileName;
|
||||||
|
Result := Read(AObject);
|
||||||
|
finally
|
||||||
|
Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure WriteToXML(AObject: TObject; const AFileName: string);
|
||||||
|
begin
|
||||||
|
with TX2UtPersistXML.Create do
|
||||||
|
try
|
||||||
|
FileName := AFileName;
|
||||||
|
Write(AObject);
|
||||||
|
finally
|
||||||
|
Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TX2UtPersistXML }
|
||||||
|
function TX2UtPersistXML.CreateFiler(AIsReader: Boolean): IX2PersistFiler;
|
||||||
|
begin
|
||||||
|
Result := TX2UtPersistXMLFiler.Create(AIsReader, Self.FileName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TX2UtPersistXML }
|
||||||
|
constructor TX2UtPersistXMLFiler.Create(AIsReader: Boolean; const AFileName: string);
|
||||||
|
begin
|
||||||
|
inherited Create(AIsReader);
|
||||||
|
|
||||||
|
FSectionStack := TInterfaceList.Create;
|
||||||
|
FFileName := AFileName;
|
||||||
|
|
||||||
|
if AIsReader then
|
||||||
|
FConfiguration := LoadConfiguration(AFileName)
|
||||||
|
else
|
||||||
|
FConfiguration := NewConfiguration;
|
||||||
|
|
||||||
|
FSection := FConfiguration;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
destructor TX2UtPersistXMLFiler.Destroy;
|
||||||
|
begin
|
||||||
|
if not IsReader then
|
||||||
|
Configuration.OwnerDocument.SaveToFile(FileName);
|
||||||
|
|
||||||
|
FreeAndNil(FSectionStack);
|
||||||
|
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistXMLFiler.BeginSection(const AName: String): Boolean;
|
||||||
|
var
|
||||||
|
sectionIndex: Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
|
||||||
|
for sectionIndex := 0 to Pred(Section.section.Count) do
|
||||||
|
begin
|
||||||
|
if SameText(Section.section[sectionIndex].name, AName) then
|
||||||
|
begin
|
||||||
|
Result := True;
|
||||||
|
FSection := Section.section[sectionIndex];
|
||||||
|
Break;;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if not Result then
|
||||||
|
begin
|
||||||
|
FSection := Section.section.Add;
|
||||||
|
FSection.name := AName;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if Result then
|
||||||
|
begin
|
||||||
|
SectionStack.Add(Section);
|
||||||
|
inherited BeginSection(AName);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2UtPersistXMLFiler.EndSection;
|
||||||
|
begin
|
||||||
|
inherited;
|
||||||
|
|
||||||
|
if SectionStack.Count > 0 then
|
||||||
|
begin
|
||||||
|
FSection := (SectionStack[Pred(SectionStack.Count)] as IXMLSection);
|
||||||
|
SectionStack.Delete(Pred(SectionStack.Count));
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2UtPersistXMLFiler.GetKeys(const ADest: TStrings);
|
||||||
|
var
|
||||||
|
valueIndex: Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
for valueIndex := 0 to Pred(Section.value.Count) do
|
||||||
|
ADest.Add(Section.value[valueIndex].name);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2UtPersistXMLFiler.GetSections(const ADest: TStrings);
|
||||||
|
var
|
||||||
|
sectionIndex: Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
for sectionIndex := 0 to Pred(Section.section.Count) do
|
||||||
|
ADest.Add(Section.section[sectionIndex].name);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistXMLFiler.ReadValue(const AName: string; out AValue: string): Boolean;
|
||||||
|
var
|
||||||
|
valueIndex: Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
AValue := '';
|
||||||
|
|
||||||
|
for valueIndex := 0 to Pred(Section.value.Count) do
|
||||||
|
if SameText(Section.value[valueIndex].name, AName) then
|
||||||
|
begin
|
||||||
|
AValue := Section.value[valueIndex].Text;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistXMLFiler.ReadInteger(const AName: String; out AValue: Integer): Boolean;
|
||||||
|
var
|
||||||
|
value: string;
|
||||||
|
|
||||||
|
begin
|
||||||
|
AValue := 0;
|
||||||
|
Result := ReadValue(AName, value) and TryStrToInt(value, AValue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistXMLFiler.ReadFloat(const AName: String; out AValue: Extended): Boolean;
|
||||||
|
var
|
||||||
|
value: string;
|
||||||
|
|
||||||
|
begin
|
||||||
|
AValue := 0;
|
||||||
|
Result := ReadValue(AName, value) and TryStrToFloat(value, AValue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistXMLFiler.ReadStream(const AName: string; AStream: TStream): Boolean;
|
||||||
|
begin
|
||||||
|
raise EAbstractError.Create('Stream not yet supported in XML');
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistXMLFiler.ReadString(const AName: String; out AValue: String): Boolean;
|
||||||
|
var
|
||||||
|
value: string;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := ReadValue(AName, value);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistXMLFiler.ReadInt64(const AName: String; out AValue: Int64): Boolean;
|
||||||
|
var
|
||||||
|
value: string;
|
||||||
|
|
||||||
|
begin
|
||||||
|
AValue := 0;
|
||||||
|
Result := ReadValue(AName, value) and TryStrToInt64(value, AValue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistXMLFiler.WriteValue(const AName, AValue: string): Boolean;
|
||||||
|
var
|
||||||
|
value: IXMLvalue;
|
||||||
|
valueIndex: Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Result := False;
|
||||||
|
value := nil;
|
||||||
|
|
||||||
|
for valueIndex := 0 to Pred(Section.value.Count) do
|
||||||
|
if SameText(Section.value[valueIndex].name, AName) then
|
||||||
|
begin
|
||||||
|
value := Section.value[valueIndex];
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if not Assigned(value) then
|
||||||
|
begin
|
||||||
|
value := Section.value.Add;
|
||||||
|
value.name := AName;
|
||||||
|
end;
|
||||||
|
|
||||||
|
if Assigned(value) then
|
||||||
|
begin
|
||||||
|
value.Text := AValue;
|
||||||
|
Result := True;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistXMLFiler.WriteInteger(const AName: String; AValue: Integer): Boolean;
|
||||||
|
begin
|
||||||
|
Result := WriteValue(AName, IntToStr(AValue));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistXMLFiler.WriteFloat(const AName: String; AValue: Extended): Boolean;
|
||||||
|
begin
|
||||||
|
Result := WriteValue(AName, FloatToStr(AValue));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistXMLFiler.WriteStream(const AName: string; AStream: TStream): Boolean;
|
||||||
|
begin
|
||||||
|
raise EAbstractError.Create('Stream not yet supported in XML');
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistXMLFiler.WriteString(const AName, AValue: String): Boolean;
|
||||||
|
begin
|
||||||
|
Result := WriteValue(AName, AValue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TX2UtPersistXMLFiler.WriteInt64(const AName: String; AValue: Int64): Boolean;
|
||||||
|
begin
|
||||||
|
Result := WriteValue(AName, IntToStr(AValue));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2UtPersistXMLFiler.DeleteKey(const AName: string);
|
||||||
|
var
|
||||||
|
valueIndex: Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
for valueIndex := 0 to Pred(Section.value.Count) do
|
||||||
|
if SameText(Section.value[valueIndex].name, AName) then
|
||||||
|
begin
|
||||||
|
Section.value.Delete(valueIndex);
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TX2UtPersistXMLFiler.DeleteSection(const AName: string);
|
||||||
|
var
|
||||||
|
sectionIndex: Integer;
|
||||||
|
|
||||||
|
begin
|
||||||
|
for sectionIndex := 0 to Pred(Section.section.Count) do
|
||||||
|
if SameText(Section.section[sectionIndex].name, AName) then
|
||||||
|
begin
|
||||||
|
Section.section.Delete(sectionIndex);
|
||||||
|
Break;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
277
X2UtPersistXMLBinding.pas
Normal file
277
X2UtPersistXMLBinding.pas
Normal file
@ -0,0 +1,277 @@
|
|||||||
|
{
|
||||||
|
X2Software XML Data Binding
|
||||||
|
|
||||||
|
Generated on: 18-2-2011 15:23:30
|
||||||
|
Generated from: P:\test\X2Utils\XSD\PersistXML.xsd
|
||||||
|
}
|
||||||
|
unit X2UtPersistXMLBinding;
|
||||||
|
|
||||||
|
interface
|
||||||
|
uses
|
||||||
|
Classes,
|
||||||
|
XMLDoc,
|
||||||
|
XMLIntf,
|
||||||
|
XMLDataBindingUtils;
|
||||||
|
|
||||||
|
type
|
||||||
|
{ Forward declarations for PersistXML }
|
||||||
|
IXMLSection = interface;
|
||||||
|
IXMLvalueList = interface;
|
||||||
|
IXMLsectionList = interface;
|
||||||
|
IXMLvalue = interface;
|
||||||
|
IXMLConfiguration = interface;
|
||||||
|
|
||||||
|
{ Interfaces for PersistXML }
|
||||||
|
IXMLSection = interface(IXMLNode)
|
||||||
|
['{37E1BD74-261B-44DA-BA06-162DBE32160C}']
|
||||||
|
function Getsection: IXMLsectionList;
|
||||||
|
function Getvalue: IXMLvalueList;
|
||||||
|
function GetHasname: Boolean;
|
||||||
|
function Getname: WideString;
|
||||||
|
|
||||||
|
procedure Setname(const Value: WideString);
|
||||||
|
|
||||||
|
property section: IXMLsectionList read Getsection;
|
||||||
|
property value: IXMLvalueList read Getvalue;
|
||||||
|
property Hasname: Boolean read GetHasname;
|
||||||
|
property name: WideString read Getname write Setname;
|
||||||
|
end;
|
||||||
|
|
||||||
|
IXMLvalueList = interface(IXMLNodeCollection)
|
||||||
|
['{267C86A8-44E3-4532-8ABE-15B1EDBFD78D}']
|
||||||
|
function Get_value(Index: Integer): IXMLvalue;
|
||||||
|
function Add: IXMLvalue;
|
||||||
|
function Insert(Index: Integer): IXMLvalue;
|
||||||
|
|
||||||
|
property value[Index: Integer]: IXMLvalue read Get_value; default;
|
||||||
|
end;
|
||||||
|
|
||||||
|
IXMLsectionList = interface(IXMLNodeCollection)
|
||||||
|
['{2C43C489-F92B-4E8F-873F-3825FC294945}']
|
||||||
|
function Get_section(Index: Integer): IXMLSection;
|
||||||
|
function Add: IXMLSection;
|
||||||
|
function Insert(Index: Integer): IXMLSection;
|
||||||
|
|
||||||
|
property section[Index: Integer]: IXMLSection read Get_section; default;
|
||||||
|
end;
|
||||||
|
|
||||||
|
IXMLvalue = interface(IXMLNode)
|
||||||
|
['{63A166DE-F145-4A3E-941B-6A937DE0B783}']
|
||||||
|
function GetHasname: Boolean;
|
||||||
|
function Getname: WideString;
|
||||||
|
|
||||||
|
procedure Setname(const Value: WideString);
|
||||||
|
|
||||||
|
property Hasname: Boolean read GetHasname;
|
||||||
|
property name: WideString read Getname write Setname;
|
||||||
|
end;
|
||||||
|
|
||||||
|
IXMLConfiguration = interface(IXMLSection)
|
||||||
|
['{81AAD8C2-F976-4203-B9D6-646408E5DE8A}']
|
||||||
|
procedure XSDValidateDocument;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Classes for PersistXML }
|
||||||
|
TXMLSection = class(TXMLNode, IXMLSection)
|
||||||
|
private
|
||||||
|
Fsection: IXMLsectionList;
|
||||||
|
Fvalue: IXMLvalueList;
|
||||||
|
public
|
||||||
|
procedure AfterConstruction; override;
|
||||||
|
protected
|
||||||
|
function Getsection: IXMLsectionList;
|
||||||
|
function Getvalue: IXMLvalueList;
|
||||||
|
function GetHasname: Boolean;
|
||||||
|
function Getname: WideString;
|
||||||
|
|
||||||
|
procedure Setname(const Value: WideString);
|
||||||
|
end;
|
||||||
|
|
||||||
|
TXMLvalueList = class(TXMLNodeCollection, IXMLvalueList)
|
||||||
|
public
|
||||||
|
procedure AfterConstruction; override;
|
||||||
|
protected
|
||||||
|
function Get_value(Index: Integer): IXMLvalue;
|
||||||
|
function Add: IXMLvalue;
|
||||||
|
function Insert(Index: Integer): IXMLvalue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TXMLsectionList = class(TXMLNodeCollection, IXMLsectionList)
|
||||||
|
public
|
||||||
|
procedure AfterConstruction; override;
|
||||||
|
protected
|
||||||
|
function Get_section(Index: Integer): IXMLSection;
|
||||||
|
function Add: IXMLSection;
|
||||||
|
function Insert(Index: Integer): IXMLSection;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TXMLvalue = class(TXMLNode, IXMLvalue)
|
||||||
|
protected
|
||||||
|
function GetHasname: Boolean;
|
||||||
|
function Getname: WideString;
|
||||||
|
|
||||||
|
procedure Setname(const Value: WideString);
|
||||||
|
end;
|
||||||
|
|
||||||
|
TXMLConfiguration = class(TXMLSection, IXMLConfiguration)
|
||||||
|
protected
|
||||||
|
procedure XSDValidateDocument;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ Document functions }
|
||||||
|
function GetConfiguration(ADocument: XMLIntf.IXMLDocument): IXMLConfiguration;
|
||||||
|
function LoadConfiguration(const AFileName: String): IXMLConfiguration;
|
||||||
|
function LoadConfigurationFromStream(AStream: TStream): IXMLConfiguration;
|
||||||
|
function NewConfiguration: IXMLConfiguration;
|
||||||
|
|
||||||
|
|
||||||
|
const
|
||||||
|
TargetNamespace = '';
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
uses
|
||||||
|
SysUtils;
|
||||||
|
|
||||||
|
{ Document functions }
|
||||||
|
function GetConfiguration(ADocument: XMLIntf.IXMLDocument): IXMLConfiguration;
|
||||||
|
begin
|
||||||
|
Result := ADocument.GetDocBinding('Configuration', TXMLConfiguration, TargetNamespace) as IXMLConfiguration
|
||||||
|
end;
|
||||||
|
|
||||||
|
function LoadConfiguration(const AFileName: String): IXMLConfiguration;
|
||||||
|
begin
|
||||||
|
Result := LoadXMLDocument(AFileName).GetDocBinding('Configuration', TXMLConfiguration, TargetNamespace) as IXMLConfiguration
|
||||||
|
end;
|
||||||
|
|
||||||
|
function LoadConfigurationFromStream(AStream: TStream): IXMLConfiguration;
|
||||||
|
var
|
||||||
|
doc: XMLIntf.IXMLDocument;
|
||||||
|
|
||||||
|
begin
|
||||||
|
doc := NewXMLDocument;
|
||||||
|
doc.LoadFromStream(AStream);
|
||||||
|
Result := GetConfiguration(doc);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function NewConfiguration: IXMLConfiguration;
|
||||||
|
begin
|
||||||
|
Result := NewXMLDocument.GetDocBinding('Configuration', TXMLConfiguration, TargetNamespace) as IXMLConfiguration
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
{ Implementation for PersistXML }
|
||||||
|
procedure TXMLSection.AfterConstruction;
|
||||||
|
begin
|
||||||
|
RegisterChildNode('section', TXMLSection);
|
||||||
|
Fsection := CreateCollection(TXMLsectionList, IXMLSection, 'section') as IXMLsectionList;
|
||||||
|
RegisterChildNode('section', TXMLSection);
|
||||||
|
RegisterChildNode('value', TXMLvalue);
|
||||||
|
Fvalue := CreateCollection(TXMLvalueList, IXMLvalue, 'value') as IXMLvalueList;
|
||||||
|
RegisterChildNode('value', TXMLvalue);
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TXMLSection.Getsection: IXMLsectionList;
|
||||||
|
begin
|
||||||
|
Result := Fsection;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TXMLSection.Getvalue: IXMLvalueList;
|
||||||
|
begin
|
||||||
|
Result := Fvalue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TXMLSection.GetHasname: Boolean;
|
||||||
|
begin
|
||||||
|
Result := Assigned(AttributeNodes.FindNode('name'));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TXMLSection.Getname: WideString;
|
||||||
|
begin
|
||||||
|
Result := AttributeNodes['name'].Text;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TXMLSection.Setname(const Value: WideString);
|
||||||
|
begin
|
||||||
|
SetAttribute('name', Value);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TXMLvalueList.AfterConstruction;
|
||||||
|
begin
|
||||||
|
RegisterChildNode('value', TXMLvalue);
|
||||||
|
|
||||||
|
ItemTag := 'value';
|
||||||
|
ItemInterface := IXMLvalue;
|
||||||
|
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TXMLvalueList.Get_value(Index: Integer): IXMLvalue;
|
||||||
|
begin
|
||||||
|
Result := (List[Index] as IXMLvalue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TXMLvalueList.Add: IXMLvalue;
|
||||||
|
begin
|
||||||
|
Result := (AddItem(-1) as IXMLvalue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TXMLvalueList.Insert(Index: Integer): IXMLvalue;
|
||||||
|
begin
|
||||||
|
Result := (AddItem(Index) as IXMLvalue);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TXMLsectionList.AfterConstruction;
|
||||||
|
begin
|
||||||
|
RegisterChildNode('section', TXMLSection);
|
||||||
|
|
||||||
|
ItemTag := 'section';
|
||||||
|
ItemInterface := IXMLSection;
|
||||||
|
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TXMLsectionList.Get_section(Index: Integer): IXMLSection;
|
||||||
|
begin
|
||||||
|
Result := (List[Index] as IXMLSection);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TXMLsectionList.Add: IXMLSection;
|
||||||
|
begin
|
||||||
|
Result := (AddItem(-1) as IXMLSection);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TXMLsectionList.Insert(Index: Integer): IXMLSection;
|
||||||
|
begin
|
||||||
|
Result := (AddItem(Index) as IXMLSection);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TXMLvalue.GetHasname: Boolean;
|
||||||
|
begin
|
||||||
|
Result := Assigned(AttributeNodes.FindNode('name'));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
function TXMLvalue.Getname: WideString;
|
||||||
|
begin
|
||||||
|
Result := AttributeNodes['name'].Text;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TXMLvalue.Setname(const Value: WideString);
|
||||||
|
begin
|
||||||
|
SetAttribute('name', Value);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TXMLConfiguration.XSDValidateDocument;
|
||||||
|
begin
|
||||||
|
XMLDataBindingUtils.XSDValidate(Self);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
end.
|
6
XSD/PersistXML.hints.xml
Normal file
6
XSD/PersistXML.hints.xml
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
<?xml version="1.0"?>
|
||||||
|
<DataBindingHints xmlns="http://www.x2software.net/xsd/databinding/DataBindingHints.xsd">
|
||||||
|
<DocumentElements>
|
||||||
|
<DocumentElement Schema="PersistXML" XPath="//xs:element[@name='Configuration']" />
|
||||||
|
</DocumentElements>
|
||||||
|
</DataBindingHints>
|
20
XSD/PersistXML.xsd
Normal file
20
XSD/PersistXML.xsd
Normal file
@ -0,0 +1,20 @@
|
|||||||
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
|
<!-- edited with XML Spy v4.3 U (http://www.xmlspy.com) by J.A. Goos (Uname IT we build it) -->
|
||||||
|
<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema" elementFormDefault="qualified" attributeFormDefault="unqualified">
|
||||||
|
<xs:element name="Configuration" type="Section"/>
|
||||||
|
<xs:complexType name="Section">
|
||||||
|
<xs:sequence>
|
||||||
|
<xs:element name="section" type="Section" minOccurs="0" maxOccurs="unbounded"/>
|
||||||
|
<xs:element name="value" minOccurs="0" maxOccurs="unbounded">
|
||||||
|
<xs:complexType>
|
||||||
|
<xs:complexContent>
|
||||||
|
<xs:extension base="xs:anyType">
|
||||||
|
<xs:attribute name="name" type="xs:string"/>
|
||||||
|
</xs:extension>
|
||||||
|
</xs:complexContent>
|
||||||
|
</xs:complexType>
|
||||||
|
</xs:element>
|
||||||
|
</xs:sequence>
|
||||||
|
<xs:attribute name="name" type="xs:string"/>
|
||||||
|
</xs:complexType>
|
||||||
|
</xs:schema>
|
Loading…
Reference in New Issue
Block a user