paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-26 14:30:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Added regular loadfromstream/saveToStream methods (bug 26003)

Browse Source 
git-svn-id: trunk@30323 -
This commit is contained in:
michael 2015-03-25 17:52:18 +00:00
parent 63405dbfdd
commit 273b945473
1 changed files with 51 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
packages/fcl-xml/src/xmlconf.pp
View File

@ -32,7 +32,7 @@ uses
SysUtils, Classes, DOM, XMLRead, XMLWrite; SysUtils, Classes, DOM, XMLRead, XMLWrite;
resourcestring resourcestring
SWrongRootName = 'XML file has wrong root element name'; SWrongRootName = 'XML file has wrong root element name: expected "%s" but was "%s"';
type type
EXMLConfigError = class(Exception); EXMLConfigError = class(Exception);
@ -76,7 +76,10 @@ type
procedure OpenKey(const aPath: DOMString); procedure OpenKey(const aPath: DOMString);
procedure CloseKey; procedure CloseKey;
procedure ResetKey; 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; const ADefault: DOMString): DOMString; overload;
function GetValue(const APath: DOMString; ADefault: Integer): Integer; overload; function GetValue(const APath: DOMString; ADefault: Integer): Integer; overload;
@ -130,18 +133,52 @@ end;
procedure TXMLConfig.Flush; procedure TXMLConfig.Flush;
begin begin
if Modified and not FReadOnly then if Modified and not FReadOnly then
begin if (FFileName<>'') then
SaveToFile(FFilename) SaveToFile(FFilename)
end; 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; end;
procedure TXMLConfig.SaveToFile(AFileName: string); procedure TXMLConfig.SaveToStream(S: TStream);
begin begin
if AFileName <> '' then WriteXMLFile(Doc,S);
begin
WriteXMLFile(Doc, AFilename);
FModified := False; FModified := False;
end; 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; end;
function TXMLConfig.GetValue(const APath: DOMString; const ADefault: DOMString): DOMString; function TXMLConfig.GetValue(const APath: DOMString; const ADefault: DOMString): DOMString;
@ -364,24 +401,16 @@ begin
Flush; Flush;
FreeAndNil(Doc); FreeAndNil(Doc);
FFilename := AFilename;
if csLoading in ComponentState then if csLoading in ComponentState then
exit; exit;
if FileExists(AFilename) and not FStartEmpty then if FileExists(AFilename) and not FStartEmpty then
ReadXMLFile(Doc, AFilename); LoadFromFile(AFilename)
else if not Assigned(Doc) then
if not Assigned(Doc) then begin
FFileName:=AFileName;
Doc := TXMLDocument.Create; Doc := TXMLDocument.Create;
if not Assigned(Doc.DocumentElement) then
Doc.AppendChild(Doc.CreateElement(FRootName)) Doc.AppendChild(Doc.CreateElement(FRootName))
else end;
if Doc.DocumentElement.NodeName <> FRootName then
raise EXMLConfigError.Create(SWrongRootName);
end; end;
procedure TXMLConfig.SetFilename(const AFilename: String); procedure TXMLConfig.SetFilename(const AFilename: String);