paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-09 22:09:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-xml: Added new property to XmlConf to allow opening file in read only mode. Added also a save as method.

Browse Source 
git-svn-id: trunk@27794 -
This commit is contained in:
mazen 2014-05-15 19:23:44 +00:00
parent 2f8a1706e6
commit 141ead4e62
1 changed files with 15 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -43,6 +43,8 @@ type
is the name of the value. The path components will be mapped to XML
elements, the name will be an element attribute.}
{ TXMLConfig }
TXMLConfig = class(TComponent)
private
FFilename: String;
@ -64,6 +66,7 @@ type
protected
Doc: TXMLDocument;
FModified: Boolean;
FReadOnly: Boolean;
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
@ -73,6 +76,7 @@ type
procedure OpenKey(const aPath: DOMString);
procedure CloseKey;
procedure ResetKey;
procedure SaveAs(AFileName: string);
function GetValue(const APath: DOMString; const ADefault: DOMString): DOMString; overload;
function GetValue(const APath: DOMString; ADefault: Integer): Integer; overload;
@ -92,6 +96,7 @@ type
property Filename: String read FFilename write SetFilename;
property StartEmpty: Boolean read FStartEmpty write SetStartEmpty;
property RootName: DOMString read FRootName write SetRootName;
property ReadOnly: Boolean read FReadOnly write FReadOnly;
end;
@ -124,9 +129,17 @@ end;
procedure TXMLConfig.Flush;
begin
if Modified and (Filename <> '') then
if Modified and not FReadOnly then
begin
WriteXMLFile(Doc, Filename);
SaveAs(FFilename)
end;
end;
procedure TXMLConfig.SaveAs(AFileName: string);
begin
if AFileName <> '' then
begin
WriteXMLFile(Doc, AFilename);
FModified := False;
end;
end;