paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-28 21:48:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Argument escaping improvements

Browse Source 
* Indent fixed for consecutive WriteXML calls
This commit is contained in:
sg 2002-09-20 11:36:51 +00:00
parent 153efdb2a7
commit 4906fc9e1a
1 changed files with 30 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
fcl/xml/xmlwrite.pp
View File

@ -3,7 +3,7 @@
This file is part of the Free Component Library This file is part of the Free Component Library
XML writing routines XML writing routines
Copyright (c) 1999-2000 by Sebastian Guenther, sg@freepascal.org Copyright (c) 1999-2002 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.
@ -28,9 +28,9 @@ procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String);
procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text); procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text);
procedure WriteXMLFile(doc: TXMLDocument; var AStream: TStream); procedure WriteXMLFile(doc: TXMLDocument; var AStream: TStream);
procedure WriteXML(Element: TDOMNode; const AFileName: String); procedure WriteXML(Node: TDOMNode; const AFileName: String);
procedure WriteXML(Element: TDOMNode; var AFile: Text); procedure WriteXML(Node: TDOMNode; var AFile: Text);
procedure WriteXML(Element: TDOMNode; var AStream: TStream); procedure WriteXML(Node: TDOMNode; var AStream: TStream);
// =================================================================== // ===================================================================
@ -206,7 +206,6 @@ begin
attr := node.Attributes.Item[i]; attr := node.Attributes.Item[i];
wrt(' ' + attr.NodeName + '='); wrt(' ' + attr.NodeName + '=');
s := attr.NodeValue; s := attr.NodeValue;
// !!!: Replace special characters in "s" such as '&', '<', '>'
wrt('"'); wrt('"');
ConvWrite(s, AttrSpecialChars, @AttrSpecialCharCallback); ConvWrite(s, AttrSpecialChars, @AttrSpecialCharCallback);
wrt('"'); wrt('"');
@ -315,6 +314,7 @@ end;
procedure InitWriter; procedure InitWriter;
begin begin
InsideTextNode := False; InsideTextNode := False;
SetLength(Indent, 0);
end; end;
procedure RootWriter(doc: TXMLDocument); procedure RootWriter(doc: TXMLDocument);
@ -324,20 +324,28 @@ begin
InitWriter; InitWriter;
wrt('<?xml version="'); wrt('<?xml version="');
if Length(doc.XMLVersion) > 0 then if Length(doc.XMLVersion) > 0 then
wrt(doc.XMLVersion) ConvWrite(doc.XMLVersion, AttrSpecialChars, @AttrSpecialCharCallback)
else else
wrt('1.0'); wrt('1.0');
wrt('"'); wrt('"');
if Length(doc.Encoding) > 0 then if Length(doc.Encoding) > 0 then
wrt(' encoding="' + doc.Encoding + '"'); begin
wrt(' encoding="');
ConvWrite(doc.Encoding, AttrSpecialChars, @AttrSpecialCharCallback);
wrt('"');
end;
wrtln('?>'); wrtln('?>');
if Length(doc.StylesheetType) > 0 then if Length(doc.StylesheetType) > 0 then
// !!!: Can't handle with HRefs which contain special chars (" and so on) begin
wrtln(Format('<?xml-stylesheet type="%s" href="%s"?>', wrt('<?xml-stylesheet type="');
[doc.StylesheetType, doc.StylesheetHRef])); ConvWrite(doc.StylesheetType, AttrSpecialChars, @AttrSpecialCharCallback);
wrt('" href="');
ConvWrite(doc.StylesheetHRef, AttrSpecialChars, @AttrSpecialCharCallback);
wrtln('"?>');
end;
indent := ''; SetLength(Indent, 0);
child := doc.FirstChild; child := doc.FirstChild;
while Assigned(Child) do while Assigned(Child) do
@ -378,32 +386,32 @@ begin
end; end;
procedure WriteXML(Element: TDOMNode; const AFileName: String); procedure WriteXML(Node: TDOMNode; const AFileName: String);
begin begin
Stream := TFileStream.Create(AFileName, fmCreate); Stream := TFileStream.Create(AFileName, fmCreate);
wrt := @Stream_Write; wrt := @Stream_Write;
wrtln := @Stream_WriteLn; wrtln := @Stream_WriteLn;
InitWriter; InitWriter;
WriteNode(Element); WriteNode(Node);
Stream.Free; Stream.Free;
end; end;
procedure WriteXML(Element: TDOMNode; var AFile: Text); procedure WriteXML(Node: TDOMNode; var AFile: Text);
begin begin
f := @AFile; f := @AFile;
wrt := @Text_Write; wrt := @Text_Write;
wrtln := @Text_WriteLn; wrtln := @Text_WriteLn;
InitWriter; InitWriter;
WriteNode(Element); WriteNode(Node);
end; end;
procedure WriteXML(Element: TDOMNode; var AStream: TStream); procedure WriteXML(Node: TDOMNode; var AStream: TStream);
begin begin
stream := AStream; stream := AStream;
wrt := @Stream_Write; wrt := @Stream_Write;
wrtln := @Stream_WriteLn; wrtln := @Stream_WriteLn;
InitWriter; InitWriter;
WriteNode(Element); WriteNode(Node);
end; end;
@ -412,7 +420,11 @@ end.
{ {
$Log$ $Log$
Revision 1.8 2002-09-20 11:04:21 michael Revision 1.9 2002-09-20 11:36:51 sg
* Argument escaping improvements
* Indent fixed for consecutive WriteXML calls
Revision 1.8 2002/09/20 11:04:21 michael
+ Changed writexml type to TDomNode instead of TDomeElement + Changed writexml type to TDomNode instead of TDomeElement
Revision 1.7 2002/09/07 15:15:29 peter Revision 1.7 2002/09/07 15:15:29 peter