From f406555e554de36a9560636d6ec068e2a5e2428c Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Fri, 18 Feb 2011 14:51:00 +0000 Subject: [PATCH] Added: PersistXML implementation --- Packages/D2007/X2Utils.dpk | 29 ++- Packages/D2007/X2Utils.dproj | 59 +++++- X2UtPersistXML.pas | 371 +++++++++++++++++++++++++++++++++++ X2UtPersistXMLBinding.pas | 277 ++++++++++++++++++++++++++ XSD/PersistXML.hints.xml | 6 + XSD/PersistXML.xsd | 20 ++ 6 files changed, 752 insertions(+), 10 deletions(-) create mode 100644 X2UtPersistXML.pas create mode 100644 X2UtPersistXMLBinding.pas create mode 100644 XSD/PersistXML.hints.xml create mode 100644 XSD/PersistXML.xsd diff --git a/Packages/D2007/X2Utils.dpk b/Packages/D2007/X2Utils.dpk index 0e12d8b..c77e955 100644 --- a/Packages/D2007/X2Utils.dpk +++ b/Packages/D2007/X2Utils.dpk @@ -30,7 +30,30 @@ package X2Utils; requires rtl, 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 X2UtApp in '..\..\X2UtApp.pas', @@ -53,6 +76,8 @@ contains X2UtPersistForm in '..\..\X2UtPersistForm.pas', X2UtPersistIntf in '..\..\X2UtPersistIntf.pas', X2UtPersistRegistry in '..\..\X2UtPersistRegistry.pas', - X2UtElevation in '..\..\X2UtElevation.pas'; + X2UtElevation in '..\..\X2UtElevation.pas', + X2UtPersistXML in '..\..\X2UtPersistXML.pas', + X2UtPersistXMLBinding in '..\..\X2UtPersistXMLBinding.pas'; end. diff --git a/Packages/D2007/X2Utils.dproj b/Packages/D2007/X2Utils.dproj index da6ddd4..5416802 100644 --- a/Packages/D2007/X2Utils.dproj +++ b/Packages/D2007/X2Utils.dproj @@ -1,11 +1,12 @@ - + + {3cd28184-f9a5-4320-9ad8-80ef25ba762e} X2Utils.dpk Debug AnyCPU DCC32 - ..\..\..\bpl\D2006\X2Utils2007.bpl + %DELPHIBIN%\X2Utils2007.bpl 7.0 @@ -32,6 +33,26 @@ FalseTrueFalseX2UtilsTrueFalseTrue2007TrueFalse1000FalseFalseFalseFalseFalse104312521.0.0.01.0.0.0X2Utils.dpk + + + + + + + + + + + + + + + + + + + + Microsoft Office 2000 Sample Automation Server Wrapper Components Microsoft Office XP Sample Automation Server Wrapper Components @@ -42,9 +63,6 @@ MainSource - - - @@ -61,13 +79,38 @@ + + - - - + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/X2UtPersistXML.pas b/X2UtPersistXML.pas new file mode 100644 index 0000000..472e205 --- /dev/null +++ b/X2UtPersistXML.pas @@ -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. + diff --git a/X2UtPersistXMLBinding.pas b/X2UtPersistXMLBinding.pas new file mode 100644 index 0000000..9e97070 --- /dev/null +++ b/X2UtPersistXMLBinding.pas @@ -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. diff --git a/XSD/PersistXML.hints.xml b/XSD/PersistXML.hints.xml new file mode 100644 index 0000000..6ecf63b --- /dev/null +++ b/XSD/PersistXML.hints.xml @@ -0,0 +1,6 @@ + + + + + + diff --git a/XSD/PersistXML.xsd b/XSD/PersistXML.xsd new file mode 100644 index 0000000..201037c --- /dev/null +++ b/XSD/PersistXML.xsd @@ -0,0 +1,20 @@ + + + + + + + + + + + + + + + + + + + +