← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/lazutils/laz_xmlwrite.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/lazutils/laz_xmlwrite.pas
 
1
{
 
2
    $Id: laz_xmlwrite.pas 32678 2011-10-04 22:42:44Z mattias $
 
3
    This file is part of the Free Component Library
 
4
 
 
5
    XML writing routines
 
6
    Copyright (c) 1999-2000 by Sebastian Guenther, sg@freepascal.org
 
7
 
 
8
    See the file COPYING.modifiedLGPL.txt, included in this distribution,
 
9
    for details about the copyright.
 
10
 
 
11
    This program is distributed in the hope that it will be useful,
 
12
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
13
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
14
 
 
15
 **********************************************************************}
 
16
 
 
17
 
 
18
unit Laz_XMLWrite;
 
19
 
 
20
{$MODE objfpc}
 
21
{$H+}
 
22
 
 
23
interface
 
24
 
 
25
uses Classes, LazUTF8, Laz_DOM;
 
26
 
 
27
procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String); overload;
 
28
procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text); overload;
 
29
procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream); overload;
 
30
 
 
31
procedure WriteXML(Element: TDOMNode; const AFileName: String); overload;
 
32
procedure WriteXML(Element: TDOMNode; var AFile: Text); overload;
 
33
procedure WriteXML(Element: TDOMNode; AStream: TStream); overload;
 
34
 
 
35
 
 
36
// ===================================================================
 
37
 
 
38
implementation
 
39
 
 
40
uses SysUtils;
 
41
 
 
42
// -------------------------------------------------------------------
 
43
//   Writers for the different node types
 
44
// -------------------------------------------------------------------
 
45
 
 
46
procedure WriteElement(node: TDOMNode); forward;
 
47
procedure WriteAttribute(node: TDOMNode); forward;
 
48
procedure WriteText(node: TDOMNode); forward;
 
49
procedure WriteCDATA(node: TDOMNode); forward;
 
50
procedure WriteEntityRef(node: TDOMNode); forward;
 
51
procedure WriteEntity(node: TDOMNode); forward;
 
52
procedure WritePI(node: TDOMNode); forward;
 
53
procedure WriteComment(node: TDOMNode); forward;
 
54
procedure WriteDocument(node: TDOMNode); forward;
 
55
procedure WriteDocumentType(node: TDOMNode); forward;
 
56
procedure WriteDocumentFragment(node: TDOMNode); forward;
 
57
procedure WriteNotation(node: TDOMNode); forward;
 
58
 
 
59
function NodeFrontIsText(Node: TDOMNode): boolean;
 
60
begin
 
61
  Result:=(Node is TDOMText) or (Node.ParentNode is TDOMText)
 
62
          or (Node.PreviousSibling is TDOMText);
 
63
end;
 
64
 
 
65
function NodeAfterIsText(Node: TDOMNode): boolean;
 
66
begin
 
67
  Result:=(Node is TDOMText) or (Node.ParentNode is TDOMText)
 
68
          or (Node.NextSibling is TDOMText);
 
69
end;
 
70
 
 
71
type
 
72
  TWriteNodeProc = procedure(node: TDOMNode);
 
73
 
 
74
const
 
75
  WriteProcs: array[ELEMENT_NODE..NOTATION_NODE] of TWriteNodeProc =
 
76
    (@WriteElement, @WriteAttribute, @WriteText, @WriteCDATA, @WriteEntityRef,
 
77
     @WriteEntity, @WritePI, @WriteComment, @WriteDocument, @WriteDocumentType,
 
78
     @WriteDocumentFragment, @WriteNotation);
 
79
  LineEnd: shortstring = LineEnding;
 
80
 
 
81
procedure WriteNode(node: TDOMNode);
 
82
begin
 
83
  WriteProcs[node.NodeType](node);
 
84
end;
 
85
 
 
86
 
 
87
// -------------------------------------------------------------------
 
88
//   Text file and TStream support
 
89
// -------------------------------------------------------------------
 
90
 
 
91
type
 
92
  TOutputProc = procedure(const Buffer; Count: Longint);
 
93
 
 
94
threadvar
 
95
  f: ^Text;
 
96
  stream: TStream;
 
97
  wrt, wrtln: TOutputProc;
 
98
 
 
99
procedure Text_Write(const Buffer; Count: Longint);
 
100
var s: string;
 
101
begin
 
102
  if Count>0 then begin
 
103
    SetLength(s,Count);
 
104
    System.Move(Buffer,s[1],Count);
 
105
    Write(f^, s);
 
106
  end;
 
107
end;
 
108
 
 
109
procedure Text_WriteLn(const Buffer; Count: Longint);
 
110
var s: string;
 
111
begin
 
112
  if Count>0 then begin
 
113
    SetLength(s,Count);
 
114
    System.Move(Buffer,s[1],Count);
 
115
    writeln(f^, s);
 
116
  end;
 
117
end;
 
118
 
 
119
procedure Stream_Write(const Buffer; Count: Longint);
 
120
begin
 
121
  if Count > 0 then begin
 
122
    stream.Write(Buffer, Count);
 
123
  end;
 
124
end;
 
125
 
 
126
procedure Stream_WriteLn(const Buffer; Count: Longint);
 
127
begin
 
128
  if Count > 0 then begin
 
129
    stream.Write(Buffer, Count);
 
130
    stream.Write(LineEnd[1],length(LineEnd));
 
131
  end;
 
132
end;
 
133
 
 
134
procedure wrtStr(const s: string);
 
135
begin
 
136
  if s<>'' then
 
137
    wrt(s[1],length(s));
 
138
end;
 
139
 
 
140
procedure wrtStrLn(const s: string);
 
141
begin
 
142
  if s<>'' then
 
143
    wrtln(s[1],length(s));
 
144
end;
 
145
 
 
146
procedure wrtChr(c: char);
 
147
begin
 
148
  wrt(c,1);
 
149
end;
 
150
 
 
151
procedure wrtLineEnd;
 
152
begin
 
153
  wrt(LineEnd[1],length(LineEnd));
 
154
end;
 
155
 
 
156
// -------------------------------------------------------------------
 
157
//   Indent handling
 
158
// -------------------------------------------------------------------
 
159
 
 
160
threadvar
 
161
  Indent: String;
 
162
  IndentCount: integer;
 
163
 
 
164
procedure wrtIndent;
 
165
var i: integer;
 
166
begin
 
167
  for i:=1 to IndentCount do
 
168
    wrtStr(Indent);
 
169
end;
 
170
 
 
171
procedure IncIndent;
 
172
begin
 
173
  inc(IndentCount);
 
174
end;
 
175
 
 
176
procedure DecIndent;
 
177
begin
 
178
  if IndentCount>0 then dec(IndentCount);
 
179
end;
 
180
 
 
181
 
 
182
// -------------------------------------------------------------------
 
183
//   String conversion
 
184
// -------------------------------------------------------------------
 
185
 
 
186
type
 
187
  TCharacters = set of Char;
 
188
  TSpecialCharCallback = procedure(c: Char);
 
189
 
 
190
const
 
191
  AttrSpecialChars = ['<', '>', '"', '&'];
 
192
  TextSpecialChars = ['<', '>', '&'];
 
193
 
 
194
 
 
195
procedure ConvWrite(const s: String; const SpecialChars: TCharacters;
 
196
  const SpecialCharCallback: TSpecialCharCallback);
 
197
var
 
198
  StartPos, EndPos: Integer;
 
199
begin
 
200
  StartPos := 1;
 
201
  EndPos := 1;
 
202
  while EndPos <= Length(s) do
 
203
  begin
 
204
    if s[EndPos] in SpecialChars then
 
205
    begin
 
206
      wrt(s[StartPos],EndPos - StartPos);
 
207
      SpecialCharCallback(s[EndPos]);
 
208
      StartPos := EndPos + 1;
 
209
    end;
 
210
    Inc(EndPos);
 
211
  end;
 
212
  if StartPos <= length(s) then
 
213
    wrt(s[StartPos], EndPos - StartPos);
 
214
end;
 
215
 
 
216
procedure AttrSpecialCharCallback(c: Char);
 
217
const
 
218
  QuotStr = '&quot;';
 
219
  AmpStr = '&amp;';
 
220
begin
 
221
  if c = '"' then
 
222
    wrtStr(QuotStr)
 
223
  else if c = '&' then
 
224
    wrtStr(AmpStr)
 
225
  else
 
226
    wrt(c,1);
 
227
end;
 
228
 
 
229
procedure TextnodeSpecialCharCallback(c: Char);
 
230
const
 
231
  ltStr = '&lt;';
 
232
  gtStr = '&gt;';
 
233
  AmpStr = '&amp;';
 
234
begin
 
235
  if c = '<' then
 
236
    wrtStr(ltStr)
 
237
  else if c = '>' then
 
238
    wrtStr(gtStr)
 
239
  else if c = '&' then
 
240
    wrtStr(AmpStr)
 
241
  else
 
242
    wrt(c,1);
 
243
end;
 
244
 
 
245
 
 
246
// -------------------------------------------------------------------
 
247
//   Node writers implementations
 
248
// -------------------------------------------------------------------
 
249
 
 
250
procedure WriteElement(node: TDOMNode);
 
251
var
 
252
  i: Integer;
 
253
  attr, child: TDOMNode;
 
254
  s: String;
 
255
begin
 
256
  if not NodeFrontIsText(Node) then
 
257
    wrtIndent;
 
258
  wrtChr('<');
 
259
  wrtStr(node.NodeName);
 
260
  if not (node.IsEmpty) then begin
 
261
    for i := 0 to node.Attributes.Length - 1 do
 
262
    begin
 
263
      attr := node.Attributes.Item[i];
 
264
      wrtChr(' ');
 
265
      wrtStr(attr.NodeName);
 
266
      wrtChr('=');
 
267
      s := attr.NodeValue;
 
268
      // !!!: Replace special characters in "s" such as '&', '<', '>'
 
269
      wrtChr('"');
 
270
      ConvWrite(s, AttrSpecialChars, @AttrSpecialCharCallback);
 
271
      wrtChr('"');
 
272
    end;
 
273
  end;
 
274
  Child := node.FirstChild;
 
275
  if Child = nil then begin
 
276
    wrtChr('/');
 
277
    wrtChr('>');
 
278
    if not NodeAfterIsText(Node) then
 
279
      wrtLineEnd;
 
280
  end else
 
281
  begin
 
282
    wrtChr('>');
 
283
    if not ((Node is TDOMText) or (Node.ParentNode is TDOMText) or
 
284
           (Child is TDOMText))
 
285
    then
 
286
      wrtLineEnd;
 
287
    IncIndent;
 
288
    repeat
 
289
      WriteNode(Child);
 
290
      Child := Child.NextSibling;
 
291
    until child = nil;
 
292
    DecIndent;
 
293
    if not ((Node is TDOMText) or (Node.ParentNode is TDOMText) or
 
294
           (Node.LastChild is TDOMText))
 
295
    then
 
296
      wrtIndent;
 
297
    wrtChr('<');
 
298
    wrtChr('/');
 
299
    wrtStr(node.NodeName);
 
300
    wrtChr('>');
 
301
    if not NodeAfterIsText(Node) then
 
302
      wrtLineEnd;
 
303
  end;
 
304
end;
 
305
 
 
306
procedure WriteAttribute(node: TDOMNode);
 
307
begin
 
308
  if node=nil then ;
 
309
end;
 
310
 
 
311
procedure WriteText(node: TDOMNode);
 
312
begin
 
313
  ConvWrite(node.NodeValue, TextSpecialChars, @TextnodeSpecialCharCallback);
 
314
  if node=nil then ;
 
315
end;
 
316
 
 
317
procedure WriteCDATA(node: TDOMNode);
 
318
begin
 
319
  if not NodeFrontIsText(Node) then
 
320
    wrtStr('<![CDATA[' + node.NodeValue + ']]>')
 
321
  else begin
 
322
    wrtIndent;
 
323
    wrtStrln('<![CDATA[' + node.NodeValue + ']]>')
 
324
  end;
 
325
end;
 
326
 
 
327
procedure WriteEntityRef(node: TDOMNode);
 
328
begin
 
329
  wrtChr('&');
 
330
  wrtStr(node.NodeName);
 
331
  wrtChr(';');
 
332
end;
 
333
 
 
334
procedure WriteEntity(node: TDOMNode);
 
335
begin
 
336
  if node=nil then ;
 
337
end;
 
338
 
 
339
procedure WritePI(node: TDOMNode);
 
340
begin
 
341
  if not NodeFrontIsText(Node) then wrtIndent;
 
342
  wrtChr('<'); wrtChr('!');
 
343
  wrtStr(TDOMProcessingInstruction(node).Target);
 
344
  wrtChr(' ');
 
345
  wrtStr(TDOMProcessingInstruction(node).Data);
 
346
  wrtChr('>');
 
347
  if not NodeAfterIsText(Node) then wrtLineEnd;
 
348
end;
 
349
 
 
350
procedure WriteComment(node: TDOMNode);
 
351
begin
 
352
  if not NodeFrontIsText(Node) then wrtIndent;
 
353
  wrtStr('<!--');
 
354
  wrtStr(node.NodeValue);
 
355
  wrtStr('-->');
 
356
  if not NodeAfterIsText(Node) then wrtLineEnd;
 
357
end;
 
358
 
 
359
procedure WriteDocument(node: TDOMNode);
 
360
begin
 
361
  if node=nil then ;
 
362
end;
 
363
 
 
364
procedure WriteDocumentType(node: TDOMNode);
 
365
begin
 
366
  if node=nil then ;
 
367
end;
 
368
 
 
369
procedure WriteDocumentFragment(node: TDOMNode);
 
370
begin
 
371
  if node=nil then ;
 
372
end;
 
373
 
 
374
procedure WriteNotation(node: TDOMNode);
 
375
begin
 
376
  if node=nil then ;
 
377
end;
 
378
 
 
379
procedure InitWriter;
 
380
begin
 
381
  SetLength(Indent, 0);
 
382
end;
 
383
 
 
384
procedure RootWriter(doc: TXMLDocument);
 
385
var
 
386
  Child: TDOMNode;
 
387
begin
 
388
  InitWriter;
 
389
  wrtStr('<?xml version="');
 
390
  if Length(doc.XMLVersion) > 0 then
 
391
    ConvWrite(doc.XMLVersion, AttrSpecialChars, @AttrSpecialCharCallback)
 
392
  else
 
393
    wrtStr('1.0');
 
394
  wrtChr('"');
 
395
  if Length(doc.Encoding) > 0 then
 
396
  begin
 
397
    wrtStr(' encoding="');
 
398
    ConvWrite(doc.Encoding, AttrSpecialChars, @AttrSpecialCharCallback);
 
399
    wrtStr('"');
 
400
  end;
 
401
  wrtStrln('?>');
 
402
 
 
403
  if Length(doc.StylesheetType) > 0 then
 
404
  begin
 
405
    wrtStr('<?xml-stylesheet type="');
 
406
    ConvWrite(doc.StylesheetType, AttrSpecialChars, @AttrSpecialCharCallback);
 
407
    wrtStr('" href="');
 
408
    ConvWrite(doc.StylesheetHRef, AttrSpecialChars, @AttrSpecialCharCallback);
 
409
    wrtStrln('"?>');
 
410
  end;
 
411
 
 
412
  Indent := '  ';
 
413
  IndentCount := 0;
 
414
 
 
415
  child := doc.FirstChild;
 
416
  while Assigned(Child) do
 
417
  begin
 
418
    WriteNode(Child);
 
419
    Child := Child.NextSibling;
 
420
  end;
 
421
end;
 
422
 
 
423
 
 
424
procedure WriteXMLMemStream(doc: TXMLDocument);
 
425
// internally used by the WriteXMLFile procedures
 
426
begin
 
427
  Stream:=TMemoryStream.Create;
 
428
  WriteXMLFile(doc,Stream);
 
429
  Stream.Position:=0;
 
430
end;
 
431
 
 
432
// -------------------------------------------------------------------
 
433
//   Interface implementation
 
434
// -------------------------------------------------------------------
 
435
 
 
436
{$IFDEF FPC}
 
437
  // widestrings ansistring conversion is slow and we only use ansistring anyway
 
438
    {off $DEFINE UsesFPCWidestrings}
 
439
{$ENDIF}
 
440
 
 
441
{$IFDEF UsesFPCWidestrings}
 
442
 
 
443
procedure SimpleWide2AnsiMove(source:pwidechar;dest:pchar;len:sizeint);
 
444
var
 
445
  i : sizeint;
 
446
begin
 
447
  for i:=1 to len do
 
448
   begin
 
449
     if word(source^)<256 then
 
450
      dest^:=char(word(source^))
 
451
     else
 
452
      dest^:='?';
 
453
     inc(dest);
 
454
     inc(source);
 
455
   end;
 
456
end;
 
457
 
 
458
procedure SimpleAnsi2WideMove(source:pchar;dest:pwidechar;len:sizeint);
 
459
var
 
460
  i : sizeint;
 
461
begin
 
462
  for i:=1 to len do
 
463
   begin
 
464
     dest^:=widechar(byte(source^));
 
465
     inc(dest);
 
466
     inc(source);
 
467
   end;
 
468
end;
 
469
 
 
470
const
 
471
  WideStringManager: TWideStringManager = (
 
472
    Wide2AnsiMove: @SimpleWide2AnsiMove;
 
473
    Ansi2WideMove: @SimpleAnsi2WideMove
 
474
  );
 
475
 
 
476
{$ENDIF}
 
477
 
 
478
procedure WriteXMLFile(doc: TXMLDocument; const AFileName: String);
 
479
var
 
480
  fs: TFileStream;
 
481
begin
 
482
  // write first to memory buffer and then as one whole block to file
 
483
  WriteXMLMemStream(doc);
 
484
  try
 
485
    fs := TFileStream.Create(UTF8ToSys(AFileName), fmCreate);
 
486
    fs.CopyFrom(Stream,Stream.Size);
 
487
    fs.Free;
 
488
  finally
 
489
    Stream.Free;
 
490
  end;
 
491
end;
 
492
 
 
493
procedure WriteXMLFile(doc: TXMLDocument; var AFile: Text);
 
494
{$IFDEF UsesFPCWidestrings}
 
495
var
 
496
  OldWideStringManager: TWideStringManager;
 
497
{$ENDIF}
 
498
begin
 
499
  {$IFDEF UsesFPCWidestrings}
 
500
  SetWideStringManager(WideStringManager, OldWideStringManager);
 
501
  try
 
502
  {$ENDIF}
 
503
    f := @AFile;
 
504
    wrt := @Text_Write;
 
505
    wrtln := @Text_WriteLn;
 
506
    RootWriter(doc);
 
507
  {$IFDEF UsesFPCWidestrings}
 
508
  finally
 
509
    SetWideStringManager(OldWideStringManager);
 
510
  end;
 
511
  {$ENDIF}
 
512
end;
 
513
 
 
514
procedure WriteXMLFile(doc: TXMLDocument; AStream: TStream);
 
515
{$IFDEF UsesFPCWidestrings}
 
516
var
 
517
  OldWideStringManager: TWideStringManager;
 
518
{$ENDIF}
 
519
begin
 
520
  {$IFDEF UsesFPCWidestrings}
 
521
  SetWideStringManager(WideStringManager, OldWideStringManager);
 
522
  try
 
523
  {$ENDIF}
 
524
    Stream := AStream;
 
525
    wrt := @Stream_Write;
 
526
    wrtln := @Stream_WriteLn;
 
527
    RootWriter(doc);
 
528
  {$IFDEF UsesFPCWidestrings}
 
529
  finally
 
530
    SetWideStringManager(OldWideStringManager);
 
531
  end;
 
532
  {$ENDIF}
 
533
end;
 
534
 
 
535
 
 
536
procedure WriteXML(Element: TDOMNode; const AFileName: String);
 
537
{$IFDEF UsesFPCWidestrings}
 
538
var
 
539
  OldWideStringManager: TWideStringManager;
 
540
{$ENDIF}
 
541
begin
 
542
  {$IFDEF UsesFPCWidestrings}
 
543
  SetWideStringManager(WideStringManager, OldWideStringManager);
 
544
  try
 
545
  {$ENDIF}
 
546
    Stream := TFileStream.Create(UTF8ToSys(AFileName), fmCreate);
 
547
    wrt := @Stream_Write;
 
548
    wrtln := @Stream_WriteLn;
 
549
    InitWriter;
 
550
    WriteNode(Element);
 
551
    Stream.Free;
 
552
  {$IFDEF UsesFPCWidestrings}
 
553
  finally
 
554
    SetWideStringManager(OldWideStringManager);
 
555
  end;
 
556
  {$ENDIF}
 
557
end;
 
558
 
 
559
procedure WriteXML(Element: TDOMNode; var AFile: Text);
 
560
{$IFDEF UsesFPCWidestrings}
 
561
var
 
562
  OldWideStringManager: TWideStringManager;
 
563
{$ENDIF}
 
564
begin
 
565
  {$IFDEF UsesFPCWidestrings}
 
566
  SetWideStringManager(WideStringManager, OldWideStringManager);
 
567
  try
 
568
  {$ENDIF}
 
569
    f := @AFile;
 
570
    wrt := @Text_Write;
 
571
    wrtln := @Text_WriteLn;
 
572
    InitWriter;
 
573
    WriteNode(Element);
 
574
  {$IFDEF UsesFPCWidestrings}
 
575
  finally
 
576
    SetWideStringManager(OldWideStringManager);
 
577
  end;
 
578
  {$ENDIF}
 
579
end;
 
580
 
 
581
procedure WriteXML(Element: TDOMNode; AStream: TStream);
 
582
{$IFDEF UsesFPCWidestrings}
 
583
var
 
584
  OldWideStringManager: TWideStringManager;
 
585
{$ENDIF}
 
586
begin
 
587
  {$IFDEF UsesFPCWidestrings}
 
588
  SetWideStringManager(WideStringManager, OldWideStringManager);
 
589
  try
 
590
  {$ENDIF}
 
591
    stream := AStream;
 
592
    wrt := @Stream_Write;
 
593
    wrtln := @Stream_WriteLn;
 
594
    InitWriter;
 
595
    WriteNode(Element);
 
596
  {$IFDEF UsesFPCWidestrings}
 
597
  finally
 
598
    SetWideStringManager(OldWideStringManager);
 
599
  end;
 
600
  {$ENDIF}
 
601
end;
 
602
 
 
603
end.