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

* Some improvements by Sergei Gorelkin

Browse Source 
- xmlread now detects encoding. (UTF8 and UTF16)
  - xmlread now uses single pass sequential reading mechanism
  - xmlwrite now uses a couple of classes, making it thread-safe
   

git-svn-id: trunk@3783 -
This commit is contained in:
michael 2006-06-04 09:27:38 +00:00
parent 0d4beaedaf
commit faf7cba799
2 changed files with 1227 additions and 1270 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1873
fcl/xml/xmlread.pp
View File

File diff suppressed because it is too large Load Diff

624
fcl/xml/xmlwrite.pp
View File

@ -3,8 +3,9 @@
XML writing routines XML writing routines
Copyright (c) 1999-2000 by Sebastian Guenther, sg@freepascal.org Copyright (c) 1999-2000 by Sebastian Guenther, sg@freepascal.org
Modified in 2006 by Sergei Gorelkin, sergei_gorelkin@mail.ru
See the file COPYING.modifiedLGPL, included in this distribution, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
This program is distributed in the hope that it will be useful, This program is distributed in the hope that it will be useful,
@ -16,8 +17,11 @@
unit XMLWrite; unit XMLWrite;
{$ifdef fpc}
{$MODE objfpc} {$MODE objfpc}
{$INLINE ON}
{$H+} {$H+}
{$endif}
interface interface
@ -38,149 +42,147 @@ implementation
uses SysUtils; uses SysUtils;
// -------------------------------------------------------------------
// Writers for the different node types
// -------------------------------------------------------------------
procedure WriteElement(node: TDOMNode); forward;
procedure WriteAttribute(node: TDOMNode); forward;
procedure WriteText(node: TDOMNode); forward;
procedure WriteCDATA(node: TDOMNode); forward;
procedure WriteEntityRef(node: TDOMNode); forward;
procedure WriteEntity(node: TDOMNode); forward;
procedure WritePI(node: TDOMNode); forward;
procedure WriteComment(node: TDOMNode); forward;
procedure WriteDocument(node: TDOMNode); forward;
procedure WriteDocumentType(node: TDOMNode); forward;
procedure WriteDocumentFragment(node: TDOMNode); forward;
procedure WriteNotation(node: TDOMNode); forward;
type
TWriteNodeProc = procedure(node: TDOMNode);
const
WriteProcs: array[ELEMENT_NODE..NOTATION_NODE] of TWriteNodeProc =
(@WriteElement, @WriteAttribute, @WriteText, @WriteCDATA, @WriteEntityRef,
@WriteEntity, @WritePI, @WriteComment, @WriteDocument, @WriteDocumentType,
@WriteDocumentFragment, @WriteNotation);
procedure WriteNode(node: TDOMNode);
begin
WriteProcs[node.NodeType](node);
end;
// ------------------------------------------------------------------- // -------------------------------------------------------------------
// Text file and TStream support // Text file and TStream support
// ------------------------------------------------------------------- // -------------------------------------------------------------------
type type
TOutputProc = procedure(const Buffer; Count: Longint); TOutputProc = procedure(const Buffer; Count: Longint) of object;
threadvar
f: ^Text;
stream: TStream;
wrt, wrtln: TOutputProc;
InsideTextNode: Boolean;
procedure Text_Write(const Buffer; Count: Longint);
var s: string;
begin
if Count>0 then begin
SetLength(s,Count);
System.Move(Buffer,s[1],Count);
Write(f^, s);
end;
end;
procedure Text_WriteLn(const Buffer; Count: Longint);
var s: string;
begin
if Count>0 then begin
SetLength(s,Count);
System.Move(Buffer,s[1],Count);
writeln(f^, s);
end;
end;
procedure Stream_Write(const Buffer; Count: Longint);
begin
if Count > 0 then begin
stream.Write(Buffer, Count);
end;
end;
procedure Stream_WriteLn(const Buffer; Count: Longint);
begin
if Count > 0 then begin
stream.Write(Buffer, Count);
stream.WriteByte(10);
end;
end;
procedure wrtStr(const s: string);
begin
if s<>'' then
wrt(s[1],length(s));
end;
procedure wrtStrLn(const s: string);
begin
if s<>'' then
wrtln(s[1],length(s));
end;
procedure wrtChr(c: char);
begin
wrt(c,1);
end;
procedure wrtLineEnd;
begin
wrt(#10,1);
end;
// -------------------------------------------------------------------
// Indent handling
// -------------------------------------------------------------------
threadvar
Indent: String;
IndentCount: integer;
procedure wrtIndent;
var i: integer;
begin
for i:=1 to IndentCount do
wrtStr(Indent);
end;
procedure IncIndent;
begin
inc(IndentCount);
end;
procedure DecIndent;
begin
if IndentCount>0 then dec(IndentCount);
end;
// -------------------------------------------------------------------
// String conversion
// -------------------------------------------------------------------
type
TCharacters = set of Char; TCharacters = set of Char;
TSpecialCharCallback = procedure(c: Char); TSpecialCharCallback = procedure(c: Char) of object;
TXMLWriter = class(TObject) // (TAbstractDOMVisitor)?
private
FInsideTextNode: Boolean;
FIndent: string;
FIndentCount: Integer;
procedure IncIndent; {$IFDEF FPC} inline; {$ENDIF}
procedure DecIndent; {$IFDEF FPC} inline; {$ENDIF}
procedure wrtStr(const s: string);
procedure wrtChr(c: char);
procedure wrtLineEnd; {$IFDEF FPC} inline; {$ENDIF}
procedure wrtIndent;
procedure ConvWrite(const s: String; const SpecialChars: TCharacters;
const SpecialCharCallback: TSpecialCharCallback);
procedure AttrSpecialCharCallback(c: Char);
procedure TextNodeSpecialCharCallback(c: Char);
protected
Procedure Write(Const Buffer; Count : Longint); virtual;Abstract;
Procedure Writeln(Const Buffer; Count : Longint); virtual;
procedure WriteNode(Node: TDOMNode);
procedure VisitDocument(Node: TDOMNode); // override;
procedure VisitElement(Node: TDOMNode);
procedure VisitText(Node: TDOMNode);
procedure VisitCDATA(Node: TDOMNode);
procedure VisitComment(Node: TDOMNode);
procedure VisitFragment(Node: TDOMNode);
procedure VisitAttribute(Node: TDOMNode);
procedure VisitEntity(Node: TDOMNode);
procedure VisitEntityRef(Node: TDOMNode);
procedure VisitDocumentType(Node: TDOMNode);
procedure VisitPI(Node: TDOMNode);
procedure VisitNotation(Node: TDOMNode);
end;
TTextXMLWriter = Class(TXMLWriter)
Private
F : ^Text;
Protected
Procedure Write(Const Buffer; Count : Longint);override;
Public
procedure WriteXML(Root: TDomNode; var AFile: Text); overload;
end;
TStreamXMLWriter = Class(TXMLWriter)
Private
F : TStream;
Protected
Procedure Write(Const Buffer; Count : Longint);override;
Public
procedure WriteXML(Root: TDomNode; AStream : TStream); overload;
end;
{ ---------------------------------------------------------------------
TTextXMLWriter
---------------------------------------------------------------------}
procedure TTextXMLWriter.Write(const Buffer; Count: Longint);
var
s: string;
begin
if Count>0 then
begin
SetString(s, PChar(Buffer), Count);
system.Write(f^, s);
end;
end;
{ ---------------------------------------------------------------------
TStreamXMLWriter
---------------------------------------------------------------------}
procedure TStreamXMLWriter.Write(const Buffer; Count: Longint);
begin
if Count > 0 then
F.Write(Buffer, Count);
end;
{ ---------------------------------------------------------------------
TXMLWriter
---------------------------------------------------------------------}
Procedure TXMLWriter.Writeln(Const Buffer; Count : Longint);
var
eol: byte;
begin
eol:=10;
Write(buffer,count);
Write(eol,sizeof(eol));
end;
procedure TXMLWriter.wrtStr(const s: string);
begin
if s<>'' then
write(s[1],length(s));
end;
procedure TXMLWriter.wrtChr(c: char);
begin
write(c,1);
end;
procedure TXMLWriter.wrtLineEnd;
begin
wrtChr(#10);
end;
procedure TXMLWriter.wrtIndent;
var
I: Integer;
begin
for I:=1 to FIndentCount do
wrtStr(FIndent);
end;
procedure TXMLWriter.IncIndent;
begin
Inc(FIndentCount);
end;
procedure TXMLWriter.DecIndent;
begin
if FIndentCount>0 then dec(FIndentCount);
end;
const const
AttrSpecialChars = ['<', '>', '"', '&']; AttrSpecialChars = ['<', '>', '"', '&'];
TextSpecialChars = ['<', '>', '&']; TextSpecialChars = ['<', '>', '&'];
procedure TXMLWriter.ConvWrite(const s: String; const SpecialChars: TCharacters;
procedure ConvWrite(const s: String; const SpecialChars: TCharacters;
const SpecialCharCallback: TSpecialCharCallback); const SpecialCharCallback: TSpecialCharCallback);
var var
StartPos, EndPos: Integer; StartPos, EndPos: Integer;
@ -191,30 +193,33 @@ begin
begin begin
if s[EndPos] in SpecialChars then if s[EndPos] in SpecialChars then
begin begin
wrt(s[StartPos],EndPos - StartPos); write(s[StartPos],EndPos - StartPos);
SpecialCharCallback(s[EndPos]); SpecialCharCallback(s[EndPos]);
StartPos := EndPos + 1; StartPos := EndPos + 1;
end; end;
Inc(EndPos); Inc(EndPos);
end; end;
if StartPos <= length(s) then if StartPos <= length(s) then
wrt(s[StartPos], EndPos - StartPos); write(s[StartPos], EndPos - StartPos);
end; end;
procedure AttrSpecialCharCallback(c: Char); procedure TXMLWriter.AttrSpecialCharCallback(c: Char);
const const
QuotStr = '&quot;'; QuotStr = '&quot;';
AmpStr = '&amp;'; AmpStr = '&amp;';
ltStr = '&lt;';
begin begin
if c = '"' then if c = '"' then
wrtStr(QuotStr) wrtStr(QuotStr)
else if c = '&' then else if c = '&' then
wrtStr(AmpStr) wrtStr(AmpStr)
else if c = '<' then
wrtStr(ltStr)
else else
wrt(c,1); write(c,1);
end; end;
procedure TextnodeSpecialCharCallback(c: Char); procedure TXMLWriter.TextnodeSpecialCharCallback(c: Char);
const const
ltStr = '&lt;'; ltStr = '&lt;';
gtStr = '&gt;'; gtStr = '&gt;';
@ -227,362 +232,261 @@ begin
else if c = '&' then else if c = '&' then
wrtStr(AmpStr) wrtStr(AmpStr)
else else
wrt(c,1); write(c,1);
end;
procedure TXMLWriter.WriteNode(node: TDOMNode);
begin
// Must be: node.Accept(Self);
case node.NodeType of
ELEMENT_NODE: VisitElement(node);
ATTRIBUTE_NODE: VisitAttribute(node);
TEXT_NODE: VisitText(node);
CDATA_SECTION_NODE: VisitCDATA(node);
ENTITY_REFERENCE_NODE: VisitEntityRef(node);
ENTITY_NODE: VisitEntity(node);
PROCESSING_INSTRUCTION_NODE: VisitPI(node);
COMMENT_NODE: VisitComment(node);
DOCUMENT_NODE: VisitDocument(node);
DOCUMENT_TYPE_NODE: VisitDocumentType(node);
DOCUMENT_FRAGMENT_NODE: VisitFragment(node);
NOTATION_NODE: VisitNotation(node);
end;
end; end;
// ------------------------------------------------------------------- procedure TXMLWriter.VisitElement(node: TDOMNode);
// Node writers implementations
// -------------------------------------------------------------------
procedure WriteElement(node: TDOMNode);
var var
i: Integer; i: Integer;
attr, child: TDOMNode; attr, child: TDOMNode;
SavedInsideTextNode: Boolean; SavedInsideTextNode: Boolean;
s: String; s: DOMString;
begin begin
if not InsideTextNode then if not FInsideTextNode then
wrtIndent; wrtIndent;
wrtChr('<'); wrtChr('<');
wrtStr(node.NodeName); wrtStr(UTF8Encode(node.NodeName));
for i := 0 to node.Attributes.Length - 1 do for i := 0 to node.Attributes.Length - 1 do
begin begin
attr := node.Attributes.Item[i]; attr := node.Attributes.Item[i];
wrtChr(' '); wrtChr(' ');
wrtStr(attr.NodeName); wrtStr(UTF8Encode(attr.NodeName));
wrtChr('='); wrtChr('=');
s := attr.NodeValue; s := attr.NodeValue;
// !!!: Replace special characters in "s" such as '&', '<', '>' // !!!: Replace special characters in "s" such as '&', '<', '>'
wrtChr('"'); wrtChr('"');
ConvWrite(s, AttrSpecialChars, @AttrSpecialCharCallback); ConvWrite(UTF8Encode(s), AttrSpecialChars, {$IFDEF FPC}@{$ENDIF}AttrSpecialCharCallback);
wrtChr('"'); wrtChr('"');
end; end;
Child := node.FirstChild; Child := node.FirstChild;
if Child = nil then begin if Child = nil then begin
wrtChr('/'); wrtChr('/');
wrtChr('>'); wrtChr('>');
if not InsideTextNode then wrtLineEnd; if not FInsideTextNode then wrtLineEnd;
end else end else
begin begin
SavedInsideTextNode := InsideTextNode; SavedInsideTextNode := FInsideTextNode;
wrtChr('>'); wrtChr('>');
if not (InsideTextNode or Child.InheritsFrom(TDOMText)) then if not (FInsideTextNode or Child.InheritsFrom(TDOMText)) then
wrtLineEnd; wrtLineEnd;
IncIndent; IncIndent;
repeat repeat
if Child.InheritsFrom(TDOMText) then if Child.InheritsFrom(TDOMText) then
InsideTextNode := True; FInsideTextNode := True
else // <-- fix case when CDATA is first child
FInsideTextNode := False;
WriteNode(Child); WriteNode(Child);
Child := Child.NextSibling; Child := Child.NextSibling;
until child = nil; until child = nil;
DecIndent; DecIndent;
if not InsideTextNode then if not FInsideTextNode then
wrtIndent; wrtIndent;
InsideTextNode := SavedInsideTextNode; FInsideTextNode := SavedInsideTextNode;
wrtChr('<'); wrtChr('<');
wrtChr('/'); wrtChr('/');
wrtStr(node.NodeName); wrtStr(UTF8Encode(node.NodeName));
wrtChr('>'); wrtChr('>');
if not InsideTextNode then if not FInsideTextNode then
wrtLineEnd; wrtLineEnd;
end; end;
end; end;
procedure WriteAttribute(node: TDOMNode); procedure TXMLWriter.VisitText(node: TDOMNode);
begin begin
if node=nil then ; ConvWrite(UTF8Encode(node.NodeValue), TextSpecialChars, {$IFDEF FPC}@{$ENDIF}TextnodeSpecialCharCallback);
end; end;
procedure WriteText(node: TDOMNode); procedure TXMLWriter.VisitCDATA(node: TDOMNode);
begin begin
ConvWrite(node.NodeValue, TextSpecialChars, @TextnodeSpecialCharCallback); if not FInsideTextNode then
if node=nil then ; wrtStr('<![CDATA[' + UTF8Encode(node.NodeValue) + ']]>')
end;
procedure WriteCDATA(node: TDOMNode);
begin
if not InsideTextNode then
wrtStr('<![CDATA[' + node.NodeValue + ']]>')
else begin else begin
wrtIndent; wrtIndent;
wrtStrln('<![CDATA[' + node.NodeValue + ']]>') wrtStr('<![CDATA[' + UTF8Encode(node.NodeValue) + ']]>');
wrtLineEnd;
end; end;
end; end;
procedure WriteEntityRef(node: TDOMNode); procedure TXMLWriter.VisitEntityRef(node: TDOMNode);
begin begin
wrtChr('&'); wrtChr('&');
wrtStr(node.NodeName); wrtStr(UTF8Encode(node.NodeName));
wrtChr(';'); wrtChr(';');
end; end;
procedure WriteEntity(node: TDOMNode); procedure TXMLWriter.VisitEntity(node: TDOMNode);
begin begin
if node=nil then ;
end; end;
procedure WritePI(node: TDOMNode); procedure TXMLWriter.VisitPI(node: TDOMNode);
begin begin
if not InsideTextNode then wrtIndent; if not FInsideTextNode then wrtIndent;
wrtChr('<'); wrtChr('!'); wrtChr('<'); wrtChr('?');
wrtStr(TDOMProcessingInstruction(node).Target); wrtStr(UTF8Encode(TDOMProcessingInstruction(node).Target));
wrtChr(' '); wrtChr(' ');
wrtStr(TDOMProcessingInstruction(node).Data); wrtStr(UTF8Encode(TDOMProcessingInstruction(node).Data));
wrtChr('>'); wrtChr('?'); wrtChr('>');
if not InsideTextNode then wrtLineEnd; if not FInsideTextNode then wrtLineEnd;
end; end;
procedure WriteComment(node: TDOMNode); procedure TXMLWriter.VisitComment(node: TDOMNode);
begin begin
if not InsideTextNode then wrtIndent; if not FInsideTextNode then wrtIndent;
wrtStr('<!--'); wrtStr('<!--');
wrtStr(node.NodeValue); wrtStr(UTF8Encode(node.NodeValue));
wrtStr('-->'); wrtStr('-->');
if not InsideTextNode then wrtLineEnd; if not FInsideTextNode then wrtLineEnd;
end; end;
procedure WriteDocument(node: TDOMNode); procedure TXMLWriter.VisitDocument(node: TDOMNode);
begin
if node=nil then ;
end;
procedure WriteDocumentType(node: TDOMNode);
begin
if node=nil then ;
end;
procedure WriteDocumentFragment(node: TDOMNode);
begin
if node=nil then ;
end;
procedure WriteNotation(node: TDOMNode);
begin
if node=nil then ;
end;
procedure InitWriter;
begin
InsideTextNode := False;
SetLength(Indent, 0);
end;
procedure RootWriter(doc: TXMLDocument);
var var
Child: TDOMNode; child: TDOMNode;
begin begin
InitWriter;
wrtStr('<?xml version="'); wrtStr('<?xml version="');
if Length(doc.XMLVersion) > 0 then if Length(TXMLDocument(node).XMLVersion) > 0 then
ConvWrite(doc.XMLVersion, AttrSpecialChars, @AttrSpecialCharCallback) ConvWrite(TXMLDocument(node).XMLVersion, AttrSpecialChars, {$IFDEF FPC}@{$ENDIF}AttrSpecialCharCallback)
else else
wrtStr('1.0'); wrtStr('1.0');
wrtChr('"'); wrtChr('"');
if Length(doc.Encoding) > 0 then if Length(TXMLDocument(node).Encoding) > 0 then
begin begin
wrtStr(' encoding="'); wrtStr(' encoding="');
ConvWrite(doc.Encoding, AttrSpecialChars, @AttrSpecialCharCallback); ConvWrite(TXMLDocument(node).Encoding, AttrSpecialChars, {$IFDEF FPC}@{$ENDIF}AttrSpecialCharCallback);
wrtStr('"'); wrtStr('"');
end; end;
wrtStrln('?>'); wrtStr('?>');
wrtLineEnd;
if Length(doc.StylesheetType) > 0 then if Length(TXMLDocument(node).StylesheetType) > 0 then
begin begin
wrtStr('<?xml-stylesheet type="'); wrtStr('<?xml-stylesheet type="');
ConvWrite(doc.StylesheetType, AttrSpecialChars, @AttrSpecialCharCallback); ConvWrite(TXMLDocument(node).StylesheetType, AttrSpecialChars, {$IFDEF FPC}@{$ENDIF}AttrSpecialCharCallback);
wrtStr('" href="'); wrtStr('" href="');
ConvWrite(doc.StylesheetHRef, AttrSpecialChars, @AttrSpecialCharCallback); ConvWrite(TXMLDocument(node).StylesheetHRef, AttrSpecialChars, {$IFDEF FPC}@{$ENDIF}AttrSpecialCharCallback);
wrtStrln('"?>'); wrtStr('"?>');
wrtLineEnd;
end; end;
Indent := ' '; FIndent := ' ';
IndentCount := 0; FIndentCount := 0;
child := doc.FirstChild; child := node.FirstChild;
while Assigned(Child) do while Assigned(Child) do
begin begin
WriteNode(Child); WriteNode(Child);
Child := Child.NextSibling; Child := Child.NextSibling;
end; end;
if node=nil then ;
end;
procedure TXMLWriter.VisitAttribute(Node: TDOMNode);
begin
end;
procedure TXMLWriter.VisitDocumentType(Node: TDOMNode);
begin
end;
procedure TXMLWriter.VisitFragment(Node: TDOMNode);
begin
VisitElement(Node);
end;
procedure TXMLWriter.VisitNotation(Node: TDOMNode);
begin
end; end;
procedure WriteXMLMemStream(doc: TXMLDocument); procedure TStreamXMLWriter.WriteXML(Root: TDOMNode; AStream: TStream);
// internally used by the WriteXMLFile procedures
begin begin
Stream:=TMemoryStream.Create; F:=AStream;
WriteXMLFile(doc,Stream); WriteNode(Root);
Stream.Position:=0; end;
procedure TTextXMLWriter.WriteXML(Root: TDOMNode; var AFile: Text);
begin
f := @AFile;
WriteNode(Root);
end; end;
// ------------------------------------------------------------------- // -------------------------------------------------------------------
// Interface implementation // Interface implementation
// ------------------------------------------------------------------- // -------------------------------------------------------------------
{$IFDEF FPC}
{$DEFINE UsesFPCWidestrings}
{$ENDIF}
{$IFDEF UsesFPCWidestrings}
{procedure SimpleWide2AnsiMove(source:pwidechar;dest:pchar;len:sizeint);
var
i : sizeint;
begin
for i:=1 to len do
begin
if word(source^)<256 then
dest^:=char(word(source^))
else
dest^:='?';
inc(dest);
inc(source);
end;
end;
procedure SimpleAnsi2WideMove(source:pchar;dest:pwidechar;len:sizeint);
var
i : sizeint;
begin
for i:=1 to len do
begin
dest^:=widechar(byte(source^));
inc(dest);
inc(source);
end;
end;}
{$ENDIF}
procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String); procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String);
var var
fs: TFileStream; fs: TFileStream;
begin begin
// write first to memory buffer and then as one whole block to file fs := TFileStream.Create(AFileName, fmCreate);
WriteXMLMemStream(doc);
try try
fs := TFileStream.Create(AFileName, fmCreate); WriteXMLFile(doc, fs);
fs.CopyFrom(Stream,Stream.Size);
fs.Free;
finally finally
Stream.Free; fs.Free;
end; end;
end; end;
procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text); procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text);
{$IFDEF UsesFPCWidestrings}
var
MyWideStringManager,OldWideStringManager: TWideStringManager;
{$ENDIF}
begin begin
{$IFDEF UsesFPCWidestrings} with TTextXMLWriter.Create do
GetWideStringManager(MyWideStringManager);
MyWideStringManager.Wide2AnsiMoveProc:=@defaultWide2AnsiMove;
MyWideStringManager.Ansi2WideMoveProc:=@defaultAnsi2WideMove;
SetWideStringManager(MyWideStringManager, OldWideStringManager);
try try
{$ENDIF} WriteXML(doc, AFile);
f := @AFile;
wrt := @Text_Write;
wrtln := @Text_WriteLn;
RootWriter(doc);
{$IFDEF UsesFPCWidestrings}
finally finally
SetWideStringManager(OldWideStringManager); Free;
end; end;
{$ENDIF}
end; end;
procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream); procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream);
{$IFDEF UsesFPCWidestrings}
var
OldWideStringManager: TWideStringManager;
{$ENDIF}
begin begin
{$IFDEF UsesFPCWidestrings} with TStreamXMLWriter.Create do
SetWideStringManager(WideStringManager, OldWideStringManager);
try try
{$ENDIF} WriteXML(doc, AStream);
Stream := AStream;
wrt := @Stream_Write;
wrtln := @Stream_WriteLn;
RootWriter(doc);
{$IFDEF UsesFPCWidestrings}
finally finally
SetWideStringManager(OldWideStringManager); Free;
end; end;
{$ENDIF}
end; end;
procedure WriteXML(Element: TDOMNode; const AFileName: String); procedure WriteXML(Element: TDOMNode; const AFileName: String);
{$IFDEF UsesFPCWidestrings}
var
OldWideStringManager: TWideStringManager;
{$ENDIF}
begin begin
{$IFDEF UsesFPCWidestrings} WriteXML(TXMLDocument(Element), AFileName);
SetWideStringManager(WideStringManager, OldWideStringManager);
try
{$ENDIF}
Stream := TFileStream.Create(AFileName, fmCreate);
wrt := @Stream_Write;
wrtln := @Stream_WriteLn;
InitWriter;
WriteNode(Element);
Stream.Free;
{$IFDEF UsesFPCWidestrings}
finally
SetWideStringManager(OldWideStringManager);
end;
{$ENDIF}
end; end;
procedure WriteXML(Element: TDOMNode; var AFile: Text); procedure WriteXML(Element: TDOMNode; var AFile: Text);
{$IFDEF UsesFPCWidestrings}
var
OldWideStringManager: TWideStringManager;
{$ENDIF}
begin begin
{$IFDEF UsesFPCWidestrings} WriteXML(TXMLDocument(Element), AFile);
SetWideStringManager(WideStringManager, OldWideStringManager);
try
{$ENDIF}
f := @AFile;
wrt := @Text_Write;
wrtln := @Text_WriteLn;
InitWriter;
WriteNode(Element);
{$IFDEF UsesFPCWidestrings}
finally
SetWideStringManager(OldWideStringManager);
end;
{$ENDIF}
end; end;
procedure WriteXML(Element: TDOMNode; AStream: TStream); procedure WriteXML(Element: TDOMNode; AStream: TStream);
{$IFDEF UsesFPCWidestrings}
var
OldWideStringManager: TWideStringManager;
{$ENDIF}
begin begin
{$IFDEF UsesFPCWidestrings} WriteXML(TXMLDocument(Element), AStream);
SetWideStringManager(WideStringManager, OldWideStringManager);
try
{$ENDIF}
stream := AStream;
wrt := @Stream_Write;
wrtln := @Stream_WriteLn;
InitWriter;
WriteNode(Element);
{$IFDEF UsesFPCWidestrings}
finally
SetWideStringManager(OldWideStringManager);
end;
{$ENDIF}
end; end;
end. end.