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

* Some source cleanup

Browse Source 
* Can only be used as component anymore (other constructors removed)
* New properties: UseEscaping, StartEmpty, RootName

git-svn-id: trunk@896 -
This commit is contained in:
sg 2005-08-16 13:18:14 +00:00
parent a234180e3a
commit 050ce11677
1 changed files with 190 additions and 107 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

297
fcl/xml/xmlcfg.pp
View File

@ -2,7 +2,7 @@
This file is part of the Free Component Library This file is part of the Free Component Library
Implementation of TXMLConfig class Implementation of TXMLConfig class
Copyright (c) 1999 - 2001 by Sebastian Guenther, sg@freepascal.org Copyright (c) 1999 - 2005 by Sebastian Guenther, sg@freepascal.org
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -29,10 +29,17 @@ interface
uses uses
{$IFDEF MEM_CHECK}MemCheck,{$ENDIF} {$IFDEF MEM_CHECK}MemCheck,{$ENDIF}
Classes, DOM, XMLRead, XMLWrite; SysUtils, Classes, DOM, XMLRead, XMLWrite;
resourcestring
SMissingPathName = 'A part of the pathname is invalid (missing)';
SEscapingNecessary = 'Invalid pathname, escaping must be enabled';
SWrongRootName = 'XML file has wrong root element name';
type type
EXMLConfigError = class(Exception);
{"APath" is the path and name of a value: A XML configuration file is {"APath" is the path and name of a value: A XML configuration file is
hierachical. "/" is the path delimiter, the part after the last "/" hierachical. "/" is the path delimiter, the part after the last "/"
is the name of the value. The path components will be mapped to XML is the name of the value. The path components will be mapped to XML
@ -41,16 +48,21 @@ type
TXMLConfig = class(TComponent) TXMLConfig = class(TComponent)
private private
FFilename: String; FFilename: String;
FStartEmpty: Boolean;
FUseEscaping: Boolean;
FRootName: DOMString;
procedure SetFilename(const AFilename: String; ForceReload: Boolean);
procedure SetFilename(const AFilename: String); procedure SetFilename(const AFilename: String);
procedure SetStartEmpty(AValue: Boolean);
procedure SetRootName(const AValue: DOMString);
protected protected
doc: TXMLDocument; Doc: TXMLDocument;
FModified: Boolean; FModified: Boolean;
fDoNotLoad: boolean;
procedure Loaded; override; procedure Loaded; override;
function FindNode(const APath: String; PathHasValue: boolean): TDomNode; function FindNode(const APath: String; PathHasValue: boolean): TDomNode;
function Escape(const s: String): String;
public public
constructor Create(const AFilename: String); overload; constructor Create(AOwner: TComponent); override;
constructor CreateClean(const AFilename: String);
destructor Destroy; override; destructor Destroy; override;
procedure Clear; procedure Clear;
procedure Flush; // Writes the XML file procedure Flush; // Writes the XML file
@ -68,6 +80,10 @@ type
property Modified: Boolean read FModified; property Modified: Boolean read FModified;
published published
property Filename: String read FFilename write SetFilename; property Filename: String read FFilename write SetFilename;
property StartEmpty: Boolean read FStartEmpty write SetStartEmpty;
property UseEscaping: Boolean read FUseEscaping write FUseEscaping
default True;
property RootName: DOMString read FRootName write SetRootName;
end; end;
@ -75,52 +91,36 @@ type
implementation implementation
uses SysUtils;
constructor TXMLConfig.Create(AOwner: TComponent);
constructor TXMLConfig.Create(const AFilename: String);
begin begin
inherited Create(nil); inherited Create(AOwner);
SetFilename(AFilename); FUseEscaping := True;
end; FRootName := 'CONFIG';
Doc := TXMLDocument.Create;
constructor TXMLConfig.CreateClean(const AFilename: String); Doc.AppendChild(Doc.CreateElement(RootName));
begin
inherited Create(nil);
fDoNotLoad:=true;
SetFilename(AFilename);
end; end;
destructor TXMLConfig.Destroy; destructor TXMLConfig.Destroy;
begin begin
if Assigned(doc) then if Assigned(Doc) then
begin begin
Flush; Flush;
doc.Free; Doc.Free;
end; end;
inherited Destroy; inherited Destroy;
end; end;
procedure TXMLConfig.Clear; procedure TXMLConfig.Clear;
var
cfg: TDOMElement;
begin begin
// free old document Doc.ReplaceChild(Doc.CreateElement(RootName), Doc.DocumentElement);
doc.Free;
// create new document
doc := TXMLDocument.Create;
cfg :=TDOMElement(doc.FindNode('CONFIG'));
if not Assigned(cfg) then begin
cfg := doc.CreateElement('CONFIG');
doc.AppendChild(cfg);
end;
end; end;
procedure TXMLConfig.Flush; procedure TXMLConfig.Flush;
begin begin
if Modified then if Modified then
begin begin
WriteXMLFile(doc, Filename); WriteXMLFile(Doc, Filename);
FModified := False; FModified := False;
end; end;
end; end;
@ -132,25 +132,30 @@ var
PathLen: integer; PathLen: integer;
StartPos, EndPos: integer; StartPos, EndPos: integer;
begin begin
Result:=ADefault; Result := ADefault;
PathLen:=length(APath); PathLen := Length(APath);
Node := doc.DocumentElement; Node := Doc.DocumentElement;
StartPos:=1; StartPos := 1;
while True do begin while True do
EndPos:=StartPos; begin
while (EndPos<=PathLen) and (APath[EndPos]<>'/') do inc(EndPos); EndPos := StartPos;
if EndPos>PathLen then break; while (EndPos <= PathLen) and (APath[EndPos] <> '/') do
SetLength(NodeName,EndPos-StartPos); Inc(EndPos);
Move(APath[StartPos],NodeName[1],EndPos-StartPos); if EndPos > PathLen then
StartPos:=EndPos+1; break;
Child := Node.FindNode(NodeName); SetLength(NodeName, EndPos - StartPos);
if not Assigned(Child) then exit; Move(APath[StartPos], NodeName[1], EndPos - StartPos);
StartPos := EndPos + 1;
Child := Node.FindNode(Escape(NodeName));
if not Assigned(Child) then
exit;
Node := Child; Node := Child;
end; end;
if StartPos>PathLen then exit; if StartPos > PathLen then
SetLength(NodeName,PathLen-StartPos+1); exit;
Move(APath[StartPos],NodeName[1],length(NodeName)); SetLength(NodeName, PathLen - StartPos + 1);
Attr := Node.Attributes.GetNamedItem(NodeName); Move(APath[StartPos], NodeName[1], Length(NodeName));
Attr := Node.Attributes.GetNamedItem(Escape(NodeName));
if Assigned(Attr) then if Assigned(Attr) then
Result := Attr.NodeValue; Result := Attr.NodeValue;
end; end;
@ -171,9 +176,9 @@ begin
s := GetValue(APath, s); s := GetValue(APath, s);
if AnsiCompareText(s,'TRUE')=0 then if AnsiCompareText(s, 'TRUE')=0 then
Result := True Result := True
else if AnsiCompareText(s,'FALSE')=0 then else if AnsiCompareText(s, 'FALSE')=0 then
Result := False Result := False
else else
Result := ADefault; Result := ADefault;
@ -187,15 +192,19 @@ var
StartPos, EndPos: integer; StartPos, EndPos: integer;
begin begin
Node := Doc.DocumentElement; Node := Doc.DocumentElement;
PathLen:=length(APath); PathLen := Length(APath);
StartPos:=1; StartPos:=1;
while True do begin while True do
EndPos:=StartPos; begin
while (EndPos<=PathLen) and (APath[EndPos]<>'/') do inc(EndPos); EndPos := StartPos;
if EndPos>PathLen then break; while (EndPos <= PathLen) and (APath[EndPos] <> '/') do
SetLength(NodeName,EndPos-StartPos); Inc(EndPos);
Move(APath[StartPos],NodeName[1],EndPos-StartPos); if EndPos > PathLen then
StartPos:=EndPos+1; break;
SetLength(NodeName, EndPos - StartPos);
Move(APath[StartPos], NodeName[1], EndPos - StartPos);
StartPos := EndPos + 1;
NodeName := Escape(NodeName);
Child := Node.FindNode(NodeName); Child := Node.FindNode(NodeName);
if not Assigned(Child) then if not Assigned(Child) then
begin begin
@ -205,9 +214,11 @@ begin
Node := Child; Node := Child;
end; end;
if StartPos>PathLen then exit; if StartPos > PathLen then
SetLength(NodeName,PathLen-StartPos+1); exit;
Move(APath[StartPos],NodeName[1],length(NodeName)); SetLength(NodeName, PathLen - StartPos + 1);
Move(APath[StartPos], NodeName[1], Length(NodeName));
NodeName := Escape(NodeName);
if (not Assigned(TDOMElement(Node).GetAttributeNode(NodeName))) or if (not Assigned(TDOMElement(Node).GetAttributeNode(NodeName))) or
(TDOMElement(Node)[NodeName] <> AValue) then (TDOMElement(Node)[NodeName] <> AValue) then
begin begin
@ -218,10 +229,10 @@ end;
procedure TXMLConfig.SetDeleteValue(const APath, AValue, DefValue: String); procedure TXMLConfig.SetDeleteValue(const APath, AValue, DefValue: String);
begin begin
if AValue=DefValue then if AValue = DefValue then
DeleteValue(APath) DeleteValue(APath)
else else
SetValue(APath,AValue); SetValue(APath, AValue);
end; end;
procedure TXMLConfig.SetValue(const APath: String; AValue: Integer); procedure TXMLConfig.SetValue(const APath: String; AValue: Integer);
@ -232,10 +243,10 @@ end;
procedure TXMLConfig.SetDeleteValue(const APath: String; AValue, procedure TXMLConfig.SetDeleteValue(const APath: String; AValue,
DefValue: Integer); DefValue: Integer);
begin begin
if AValue=DefValue then if AValue = DefValue then
DeleteValue(APath) DeleteValue(APath)
else else
SetValue(APath,AValue); SetValue(APath, AValue);
end; end;
procedure TXMLConfig.SetValue(const APath: String; AValue: Boolean); procedure TXMLConfig.SetValue(const APath: String; AValue: Boolean);
@ -249,7 +260,7 @@ end;
procedure TXMLConfig.SetDeleteValue(const APath: String; AValue, procedure TXMLConfig.SetDeleteValue(const APath: String; AValue,
DefValue: Boolean); DefValue: Boolean);
begin begin
if AValue=DefValue then if AValue = DefValue then
DeleteValue(APath) DeleteValue(APath)
else else
SetValue(APath,AValue); SetValue(APath,AValue);
@ -259,8 +270,9 @@ procedure TXMLConfig.DeletePath(const APath: string);
var var
Node: TDomNode; Node: TDomNode;
begin begin
Node:=FindNode(APath,false); Node := FindNode(APath, False);
if (Node=nil) or (Node.ParentNode=nil) then exit; if (Node = nil) or (Node.ParentNode = nil) then
exit;
Node.ParentNode.RemoveChild(Node); Node.ParentNode.RemoveChild(Node);
FModified := True; FModified := True;
end; end;
@ -271,12 +283,15 @@ var
StartPos: integer; StartPos: integer;
NodeName: string; NodeName: string;
begin begin
Node:=FindNode(APath,true); Node := FindNode(APath, True);
if (Node=nil) then exit; if not Assigned(Node) then
StartPos:=length(APath); exit;
while (StartPos>0) and (APath[StartPos]<>'/') do dec(StartPos); StartPos := Length(APath);
NodeName:=copy(APath,StartPos+1,length(APath)-StartPos); while (StartPos > 0) and (APath[StartPos] <> '/') do
if (not Assigned(TDOMElement(Node).GetAttributeNode(NodeName))) then exit; Dec(StartPos);
NodeName := Escape(Copy(APath, StartPos+1, Length(APath) - StartPos));
if (not Assigned(TDOMElement(Node).GetAttributeNode(NodeName))) then
exit;
TDOMElement(Node).RemoveAttribute(NodeName); TDOMElement(Node).RemoveAttribute(NodeName);
FModified := True; FModified := True;
end; end;
@ -295,54 +310,122 @@ var
StartPos, EndPos: integer; StartPos, EndPos: integer;
PathLen: integer; PathLen: integer;
begin begin
Result := doc.DocumentElement; Result := Doc.DocumentElement;
PathLen:=length(APath); PathLen := Length(APath);
StartPos:=1; StartPos := 1;
while (Result<>nil) do begin while Assigned(Result) do
EndPos:=StartPos; begin
while (EndPos<=PathLen) and (APath[EndPos]<>'/') do inc(EndPos); EndPos := StartPos;
if (EndPos>PathLen) and PathHasValue then exit; while (EndPos <= PathLen) and (APath[EndPos] <> '/') do
if EndPos=StartPos then break; Inc(EndPos);
SetLength(NodePath,EndPos-StartPos); if (EndPos > PathLen) and PathHasValue then
Move(APath[StartPos],NodePath[1],length(NodePath)); exit;
Result := Result.FindNode(NodePath); if EndPos = StartPos then
StartPos:=EndPos+1; break;
if StartPos>PathLen then exit; SetLength(NodePath, EndPos - StartPos);
Move(APath[StartPos], NodePath[1], Length(NodePath));
Result := Result.FindNode(Escape(NodePath));
StartPos := EndPos + 1;
if StartPos > PathLen then
exit;
end; end;
Result:=nil; Result := nil;
end; end;
procedure TXMLConfig.SetFilename(const AFilename: String); function TXMLConfig.Escape(const s: String): String;
const
AllowedChars = ['A'..'Z', 'a'..'z', '0'..'9', '.', '-', '_'];
var var
cfg: TDOMElement; EscapingNecessary: Boolean;
i: Integer;
begin
if Length(s) < 1 then
raise EXMLConfigError.Create(SMissingPathName);
if not (s[1] in ['A'..'Z', 'a'..'z', '_']) then
EscapingNecessary := True
else
begin
EscapingNecessary := False;
for i := 2 to Length(s) do
if not (s[i] in AllowedChars) then
begin
EscapingNecessary := True;
exit;
end;
end;
if EscapingNecessary then
if UseEscaping then
begin
Result := '_';
for i := 1 to Length(s) do
if s[i] in (AllowedChars - ['_']) then
Result := Result + s[i]
else
Result := Result + '_' + IntToHex(Ord(s[i]), 2);
end else
raise EXMLConfigError.Create(SEscapingNecessary)
else // No escaping necessary
Result := s;
end;
procedure TXMLConfig.SetFilename(const AFilename: String; ForceReload: Boolean);
begin begin
{$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLConfig.SetFilename A '+AFilename);{$ENDIF} {$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLConfig.SetFilename A '+AFilename);{$ENDIF}
if FFilename = AFilename then exit; if (not ForceReload) and (FFilename = AFilename) then
exit;
FFilename := AFilename; FFilename := AFilename;
if csLoading in ComponentState then if csLoading in ComponentState then
exit; exit;
if Assigned(doc) then Flush;
begin FreeAndNil(Doc);
Flush;
doc.Free;
end;
doc:=nil; if FileExists(AFilename) and (not FStartEmpty) then
if FileExists(AFilename) and (not fDoNotLoad) then ReadXMLFile(Doc, AFilename);
ReadXMLFile(doc,AFilename);
if not Assigned(doc) then if not Assigned(Doc) then
doc := TXMLDocument.Create; Doc := TXMLDocument.Create;
if not Assigned(Doc.DocumentElement) then
Doc.AppendChild(Doc.CreateElement(RootName))
else
if Doc.DocumentElement.NodeName <> RootName then
raise EXMLConfigError.Create('XML file has wrong root element name');
cfg :=TDOMElement(doc.FindNode('CONFIG'));
if not Assigned(cfg) then begin
cfg := doc.CreateElement('CONFIG');
doc.AppendChild(cfg);
end;
{$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLConfig.SetFilename END');{$ENDIF} {$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLConfig.SetFilename END');{$ENDIF}
end; end;
procedure TXMLConfig.SetFilename(const AFilename: String);
begin
SetFilename(AFilename, False);
end;
procedure TXMLConfig.SetRootName(const AValue: DOMString);
var
Cfg: TDOMElement;
begin
if AValue <> RootName then
begin
FRootName := AValue;
Cfg := Doc.CreateElement(AValue);
while Assigned(Doc.DocumentElement.FirstChild) do
Cfg.AppendChild(Doc.DocumentElement.FirstChild);
Doc.ReplaceChild(Cfg, Doc.DocumentElement);
FModified := True;
end;
end;
procedure TXMLConfig.SetStartEmpty(AValue: Boolean);
begin
if AValue <> StartEmpty then
begin
FStartEmpty := AValue;
if (not AValue) and not Modified then
SetFilename(Filename, True);
end;
end;
end. end.