From 734d1d494915998ac1cb133cd02e7446045333a0 Mon Sep 17 00:00:00 2001 From: marco Date: Tue, 16 Jun 2015 19:37:35 +0000 Subject: [PATCH] --- Merging r29761 into '.': U packages/fcl-xml/src/dom.pp U packages/fcl-xml/src/xmlread.pp --- Recording mergeinfo for merge of r29761 into '.': U . --- Merging r30323 into '.': U packages/fcl-xml/src/xmlconf.pp --- Recording mergeinfo for merge of r30323 into '.': G . --- Merging r30324 into '.': A packages/fcl-xml/tests/testxmlconf.lpr A packages/fcl-xml/tests/testxmlconf.lpi --- Recording mergeinfo for merge of r30324 into '.': G . # revisions: 29761,30323,30324 git-svn-id: branches/fixes_3_0@31070 - --- .gitattributes | 2 + packages/fcl-xml/src/dom.pp | 13 ++++- packages/fcl-xml/src/xmlconf.pp | 73 ++++++++++++++++++-------- packages/fcl-xml/src/xmlread.pp | 29 +++------- packages/fcl-xml/tests/testxmlconf.lpi | 64 ++++++++++++++++++++++ packages/fcl-xml/tests/testxmlconf.lpr | 31 +++++++++++ 6 files changed, 167 insertions(+), 45 deletions(-) create mode 100644 packages/fcl-xml/tests/testxmlconf.lpi create mode 100644 packages/fcl-xml/tests/testxmlconf.lpr diff --git a/.gitattributes b/.gitattributes index 682c992d82..7764e30922 100644 --- a/.gitattributes +++ b/.gitattributes @@ -3189,6 +3189,8 @@ packages/fcl-xml/tests/readertest.pp svneol=native#text/plain packages/fcl-xml/tests/readerunit.pp svneol=native#text/plain packages/fcl-xml/tests/template.xml svneol=native#text/plain packages/fcl-xml/tests/testgen.pp svneol=native#text/plain +packages/fcl-xml/tests/testxmlconf.lpi svneol=native#text/plain +packages/fcl-xml/tests/testxmlconf.lpr svneol=native#text/plain packages/fcl-xml/tests/xmlts.pp svneol=native#text/plain packages/fcl-xml/tests/xpathts.pp svneol=native#text/plain packages/fftw/Makefile svneol=native#text/plain diff --git a/packages/fcl-xml/src/dom.pp b/packages/fcl-xml/src/dom.pp index 2ac07b27ec..ec3f654da5 100644 --- a/packages/fcl-xml/src/dom.pp +++ b/packages/fcl-xml/src/dom.pp @@ -223,7 +223,6 @@ type procedure SetPrefix(const Value: DOMString); virtual; function GetOwnerDocument: TDOMDocument; virtual; function GetBaseURI: DOMString; - procedure SetReadOnly(Value: Boolean); procedure Changing; public constructor Create(AOwner: TDOMDocument); @@ -270,6 +269,7 @@ type function CloneNode(deep: Boolean; ACloneOwner: TDOMDocument): TDOMNode; overload; virtual; function FindNode(const ANodeName: DOMString): TDOMNode; virtual; function CompareName(const name: DOMString): Integer; virtual; + procedure SetReadOnly(Value: Boolean); property Flags: TNodeFlags read FFlags; end; @@ -312,6 +312,8 @@ type public property InputEncoding: DOMString read FInputEncoding; property XMLEncoding: DOMString read FXMLEncoding; + // extension + procedure SetHeaderData(aXmlVersion: TXMLVersion; const aXmlEncoding: DOMString); end; // ------------------------------------------------------- @@ -695,6 +697,8 @@ type property PublicID: DOMString read GetPublicID; property SystemID: DOMString read GetSystemID; property InternalSubset: DOMString read GetInternalSubset; + // extension + property Model: TDTDModel read FModel; end; @@ -2114,6 +2118,13 @@ begin Result := xmlVersionStr[FXMLVersion]; end; +procedure TDOMNode_TopLevel.SetHeaderData(aXmlVersion: TXMLVersion; const aXmlEncoding: DOMString); +begin + if aXmlVersion <> xmlVersionUnknown then + FXMLVersion := aXmlVersion; + FXMLEncoding := aXmlEncoding; +end; + // ------------------------------------------------------- // DOMImplementation // ------------------------------------------------------- diff --git a/packages/fcl-xml/src/xmlconf.pp b/packages/fcl-xml/src/xmlconf.pp index 9da6dd97bb..3e84cd0227 100644 --- a/packages/fcl-xml/src/xmlconf.pp +++ b/packages/fcl-xml/src/xmlconf.pp @@ -32,7 +32,7 @@ uses SysUtils, Classes, DOM, XMLRead, XMLWrite; resourcestring - SWrongRootName = 'XML file has wrong root element name'; + SWrongRootName = 'XML file has wrong root element name: expected "%s" but was "%s"'; type EXMLConfigError = class(Exception); @@ -76,7 +76,10 @@ type procedure OpenKey(const aPath: DOMString); procedure CloseKey; procedure ResetKey; - procedure SaveToFile(AFileName: string); + procedure SaveToFile(Const AFileName: string); + procedure SaveToStream(S : TStream); + procedure LoadFromFile(Const AFileName: string); + procedure LoadFromStream(S : TStream); function GetValue(const APath: DOMString; const ADefault: DOMString): DOMString; overload; function GetValue(const APath: DOMString; ADefault: Integer): Integer; overload; @@ -130,20 +133,54 @@ end; procedure TXMLConfig.Flush; begin if Modified and not FReadOnly then - begin - SaveToFile(FFilename) + if (FFileName<>'') then + SaveToFile(FFilename) +end; + +procedure TXMLConfig.SaveToFile(const AFileName: string); + +Var + F : TFileStream; + +begin + F:=TFileStream.Create(AFileName,fmCreate); + try + SaveToStream(F); + FFileName:=AFileName; + finally + F.Free; end; end; -procedure TXMLConfig.SaveToFile(AFileName: string); +procedure TXMLConfig.SaveToStream(S: TStream); begin - if AFileName <> '' then - begin - WriteXMLFile(Doc, AFilename); - FModified := False; + WriteXMLFile(Doc,S); + FModified := False; +end; + +procedure TXMLConfig.LoadFromFile(const AFileName: string); + +Var + F : TFileStream; + +begin + F:=TFileStream.Create(AFileName,fmOpenread or fmShareDenyWrite); + try + ReadXMLFile(Doc, AFilename); + FFileName:=AFileName; + finally + F.Free; end; end; +procedure TXMLConfig.LoadFromStream(S: TStream); +begin + ReadXMLFile(Doc,S); + FModified := False; + if (Doc.DocumentElement.NodeName<>FRootName) then + raise EXMLConfigError.CreateFmt(SWrongRootName,[FRootName,Doc.DocumentElement.NodeName]); +end; + function TXMLConfig.GetValue(const APath: DOMString; const ADefault: DOMString): DOMString; var Node: TDOMElement; @@ -364,24 +401,16 @@ begin Flush; FreeAndNil(Doc); - - FFilename := AFilename; - if csLoading in ComponentState then exit; - if FileExists(AFilename) and not FStartEmpty then - ReadXMLFile(Doc, AFilename); - - if not Assigned(Doc) then + LoadFromFile(AFilename) + else if not Assigned(Doc) then + begin + FFileName:=AFileName; Doc := TXMLDocument.Create; - - if not Assigned(Doc.DocumentElement) then Doc.AppendChild(Doc.CreateElement(FRootName)) - else - if Doc.DocumentElement.NodeName <> FRootName then - raise EXMLConfigError.Create(SWrongRootName); - + end; end; procedure TXMLConfig.SetFilename(const AFilename: String); diff --git a/packages/fcl-xml/src/xmlread.pp b/packages/fcl-xml/src/xmlread.pp index 941415544e..6228edf0c8 100644 --- a/packages/fcl-xml/src/xmlread.pp +++ b/packages/fcl-xml/src/xmlread.pp @@ -91,11 +91,6 @@ uses UriParser, dtdmodel; type - TDOMDocumentTypeEx = class(TDOMDocumentType); - TXMLDocumentEx = class(TXMLDocument); - - TDOMEntityEx = class(TDOMEntity); - TLoader = object doc: TDOMDocument; reader: TXMLTextReader; @@ -237,23 +232,23 @@ end; procedure TLoader.ProcessFragment(AOwner: TDOMNode; AReader: TXMLTextReader); var - DoctypeNode: TDOMDocumentTypeEx; + DoctypeNode: TDOMDocumentType; begin doc := AOwner.OwnerDocument; reader := AReader; reader.OnEntity := @ProcessEntity; reader.FragmentMode := True; reader.XML11 := doc.XMLVersion = '1.1'; - DoctypeNode := TDOMDocumentTypeEx(doc.DocType); + DoctypeNode := doc.DocType; if Assigned(DoctypeNode) then - reader.DtdSchemaInfo := DocTypeNode.FModel.Reference; + reader.DtdSchemaInfo := DocTypeNode.Model.Reference; ParseContent(aOwner as TDOMNode_WithChildren); end; procedure TLoader.ProcessEntity(Sender: TXMLTextReader; AEntity: TEntityDecl); var DoctypeNode: TDOMDocumentType; - Ent: TDOMEntityEx; + Ent: TDOMEntity; src: TXMLCharSource; InnerReader: TXMLTextReader; InnerLoader: TLoader; @@ -261,7 +256,7 @@ begin DoctypeNode := TDOMDocument(doc).DocType; if DoctypeNode = nil then Exit; - Ent := TDOMEntityEx(DocTypeNode.Entities.GetNamedItem(AEntity.FName)); + Ent := TDOMEntity(DocTypeNode.Entities.GetNamedItem(AEntity.FName)); if Ent = nil then Exit; Sender.EntityToSource(AEntity, Src); @@ -291,18 +286,8 @@ begin if not reader.Read then Exit; case cursor.NodeType of - DOCUMENT_NODE: - begin - if reader.XMLVersion <> xmlVersionUnknown then - TXMLDocumentEx(cursor).FXMLVersion := reader.XMLVersion; - TXMLDocumentEx(cursor).FXMLEncoding := reader.XMLEncoding; - end; - ENTITY_NODE: - begin - if reader.XMLVersion <> xmlVersionUnknown then - TDOMEntityEx(cursor).FXMLVersion := reader.XMLVersion; - TDOMEntityEx(cursor).FXMLEncoding := reader.XMLEncoding; - end; + DOCUMENT_NODE, ENTITY_NODE: + (cursor as TDOMNode_TopLevel).SetHeaderData(reader.XMLVersion,reader.XMLEncoding); end; end; diff --git a/packages/fcl-xml/tests/testxmlconf.lpi b/packages/fcl-xml/tests/testxmlconf.lpi new file mode 100644 index 0000000000..c2daccfe37 --- /dev/null +++ b/packages/fcl-xml/tests/testxmlconf.lpi @@ -0,0 +1,64 @@ + + + + + + + + + + + + + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <Units Count="1"> + <Unit0> + <Filename Value="testxmlconf.lpr"/> + <IsPartOfProject Value="True"/> + <UnitName Value="testxmlconf"/> + </Unit0> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="testxmlconf"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/packages/fcl-xml/tests/testxmlconf.lpr b/packages/fcl-xml/tests/testxmlconf.lpr new file mode 100644 index 0000000000..e934f8d11f --- /dev/null +++ b/packages/fcl-xml/tests/testxmlconf.lpr @@ -0,0 +1,31 @@ +program testxmlconf; + +uses xmlconf; + +begin + With TXMLConfig.Create(Nil) do + try + FileName:='test.xml'; + OpenKey('General'); + SetValue('one',1); + SetValue('two',2); + SetValue('extra/name','michael'); + Flush; + finally + Free; + end; + With TXMLConfig.Create(Nil) do + try + FileName:='test.xml'; + OpenKey('General'); + If GetValue('one',0)<>1 then + Writeln('One does not match'); + If GetValue('two',0)<>2 then + Writeln('Two does not match'); + if GetValue('extra/name','')<>'michael' then + Writeln('Name does not match'); + finally + Free; + end; +end. +