← Back to branch summary

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

« back to all changes in this revision

Viewing changes to components/lazutils/laz_xmlread.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_xmlread.pas
 
1
{
 
2
    This file is part of the Free Component Library
 
3
 
 
4
    XML reading routines.
 
5
    Copyright (c) 1999-2000 by Sebastian Guenther, sg@freepascal.org
 
6
 
 
7
    See the file COPYING.FPC, included in this distribution,
 
8
    for details about the copyright.
 
9
 
 
10
    This program is distributed in the hope that it will be useful,
 
11
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
12
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
13
 
 
14
 **********************************************************************}
 
15
 
 
16
unit Laz_XMLRead;
 
17
 
 
18
{$MODE objfpc}
 
19
{$H+}
 
20
{$inline on}
 
21
 
 
22
interface
 
23
 
 
24
{off $DEFINE MEM_CHECK}
 
25
 
 
26
uses
 
27
  {$IFDEF MEM_CHECK}MemCheck,{$ENDIF}
 
28
  SysUtils, Classes, types, LazUTF8, Laz_DOM;
 
29
 
 
30
type
 
31
 
 
32
  EXMLReadError = class(Exception)
 
33
  public
 
34
    Position: PtrInt;
 
35
    LineCol: TPoint;
 
36
    Descr: string;
 
37
  end;
 
38
 
 
39
 
 
40
procedure ReadXMLFile(out ADoc: TXMLDocument; const AFilename: String); overload;
 
41
procedure ReadXMLFile(out ADoc: TXMLDocument; var f: File); overload;
 
42
procedure ReadXMLFile(out ADoc: TXMLDocument; f: TStream); overload;
 
43
procedure ReadXMLFile(out ADoc: TXMLDocument; f: TStream; const AFilename: String); overload;
 
44
 
 
45
procedure ReadXMLFragment(AParentNode: TDOMNode; const AFilename: String); overload;
 
46
procedure ReadXMLFragment(AParentNode: TDOMNode; var f: File); overload;
 
47
procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream); overload;
 
48
procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream; const AFilename: String); overload;
 
49
 
 
50
procedure ReadDTDFile(var ADoc: TXMLDocument; const AFilename: String);  overload;
 
51
procedure ReadDTDFile(var ADoc: TXMLDocument; var f: File); overload;
 
52
procedure ReadDTDFile(var ADoc: TXMLDocument; var f: TStream); overload;
 
53
procedure ReadDTDFile(var ADoc: TXMLDocument; var f: TStream; const AFilename: String); overload;
 
54
 
 
55
 
 
56
// =======================================================
 
57
 
 
58
implementation
 
59
 
 
60
const
 
61
 
 
62
  Letter = ['A'..'Z', 'a'..'z'];
 
63
  Digit = ['0'..'9'];
 
64
  PubidChars: set of Char = [' ', #13, #10, 'a'..'z', 'A'..'Z', '0'..'9',
 
65
    '-', '''', '(', ')', '+', ',', '.', '/', ':', '=', '?', ';', '!', '*',
 
66
    '#', '@', '$', '_', '%'];
 
67
  WhitespaceChars: set of Char = [#9, #10, #13, ' '];
 
68
 
 
69
  NmToken: set of Char = Letter + Digit + ['.', '-', '_', ':'];
 
70
 
 
71
function ComparePChar(p1, p2: PChar): boolean;
 
72
begin
 
73
  if p1<>p2 then begin
 
74
    if (p1<>nil) and (p2<>nil) then begin
 
75
      while true do begin
 
76
        if (p1^=p2^) then begin
 
77
          if p1^<>#0 then begin
 
78
            inc(p1);
 
79
            inc(p2);
 
80
          end else begin
 
81
            Result:=true;
 
82
            exit;
 
83
          end;
 
84
        end else begin
 
85
          Result:=false;
 
86
          exit;
 
87
        end;
 
88
      end;
 
89
      Result:=true;
 
90
    end else begin
 
91
      Result:=false;
 
92
    end;
 
93
  end else begin
 
94
    Result:=true;
 
95
  end;
 
96
end;
 
97
 
 
98
function CompareLPChar(p1, p2: PChar; Max: integer): boolean;
 
99
begin
 
100
  if p1<>p2 then begin
 
101
    if (p1<>nil) and (p2<>nil) then begin
 
102
      while Max>0 do begin
 
103
        if (p1^=p2^) then begin
 
104
          if (p1^<>#0) then begin
 
105
            inc(p1);
 
106
            inc(p2);
 
107
            dec(Max);
 
108
          end else begin
 
109
            Result:=true;
 
110
            exit;
 
111
          end;
 
112
        end else begin
 
113
          Result:=false;
 
114
          exit;
 
115
        end;
 
116
      end;
 
117
      Result:=true;
 
118
    end else begin
 
119
      Result:=false;
 
120
    end;
 
121
  end else begin
 
122
    Result:=true;
 
123
  end;
 
124
end;
 
125
 
 
126
function CompareIPChar(p1, p2: PChar): boolean;
 
127
begin
 
128
  if p1<>p2 then begin
 
129
    if (p1<>nil) and (p2<>nil) then begin
 
130
      while true do begin
 
131
        if (p1^=p2^) or (upcase(p1^)=upcase(p2^)) then begin
 
132
          if p1^<>#0 then begin
 
133
            inc(p1);
 
134
            inc(p2);
 
135
          end else begin
 
136
            Result:=true;
 
137
            exit;
 
138
          end;
 
139
        end else begin
 
140
          Result:=false;
 
141
          exit;
 
142
        end;
 
143
      end;
 
144
      Result:=true;
 
145
    end else begin
 
146
      Result:=false;
 
147
    end;
 
148
  end else begin
 
149
    Result:=true;
 
150
  end;
 
151
end;
 
152
 
 
153
function CompareLIPChar(p1, p2: PChar; Max: integer): boolean;
 
154
begin
 
155
  if p1<>p2 then begin
 
156
    if (p1<>nil) and (p2<>nil) then begin
 
157
      while Max>0 do begin
 
158
        if (p1^=p2^) or (upcase(p1^)=upcase(p2^)) then begin
 
159
          if (p1^<>#0) then begin
 
160
            inc(p1);
 
161
            inc(p2);
 
162
            dec(Max);
 
163
          end else begin
 
164
            Result:=true;
 
165
            exit;
 
166
          end;
 
167
        end else begin
 
168
          Result:=false;
 
169
          exit;
 
170
        end;
 
171
      end;
 
172
      Result:=true;
 
173
    end else begin
 
174
      Result:=false;
 
175
    end;
 
176
  end else begin
 
177
    Result:=true;
 
178
  end;
 
179
end;
 
180
 
 
181
 
 
182
type
 
183
  TXMLReaderDocument = class(TXMLDocument)
 
184
  public
 
185
    procedure SetDocType(ADocType: TDOMDocumentType);
 
186
  end;
 
187
 
 
188
  TXMLReaderDocumentType = class(TDOMDocumentType)
 
189
  public
 
190
    constructor Create(ADocument: TXMLReaderDocument);
 
191
    property Name: DOMString read FNodeName write FNodeName;
 
192
  end;
 
193
 
 
194
 
 
195
  TSetOfChar = set of Char;
 
196
 
 
197
  { TXMLReader }
 
198
 
 
199
  TXMLReader = class
 
200
  protected
 
201
    buf, BufStart: PChar;
 
202
    Filename: String;
 
203
    function BufPosToLineCol(p: PChar): TPoint;
 
204
    function BufPosToStr(p: PChar): string;
 
205
    procedure RaiseExc(const descr: String);
 
206
    procedure RaiseCharNotFound(c : char);
 
207
    function  SkipWhitespace: Boolean;
 
208
    procedure ExpectWhitespace; inline;
 
209
    procedure ExpectChar(c: char); inline;
 
210
    procedure ExpectString(const s: String);
 
211
    function  CheckFor(s: PChar): Boolean;
 
212
    function  CheckForChar(c: Char): Boolean;
 
213
    procedure SkipString(const ValidChars: TSetOfChar);
 
214
    function  GetString(const ValidChars: TSetOfChar): String;
 
215
    function  GetString(BufPos: PChar; Len: integer): String;
 
216
 
 
217
    function  CheckName: Boolean;
 
218
    function  GetName(out s: String): Boolean;
 
219
    function  ExpectName: String;                                       // [5]
 
220
    procedure SkipName;
 
221
    procedure ExpectAttValue(attr: TDOMAttr);                           // [10]
 
222
    function  ExpectPubidLiteral: String;                               // [12]
 
223
    procedure SkipPubidLiteral;
 
224
    function  ParseComment(AOwner: TDOMNode): Boolean;                  // [15]
 
225
    function  ParsePI: Boolean;                                         // [16]
 
226
    procedure ExpectProlog;                                             // [22]
 
227
    function  ParseEq: Boolean;                                         // [25]
 
228
    procedure ExpectEq;
 
229
    procedure ParseMisc(AOwner: TDOMNode);                              // [27]
 
230
    function  ParseMarkupDecl: Boolean;                                 // [29]
 
231
    function  ParseCharData(AOwner: TDOMNode): Boolean;                 // [14]
 
232
    function  ParseCDSect(AOwner: TDOMNode): Boolean;                   // [18]
 
233
    function  ParseElement(AOwner: TDOMNode): Boolean;                  // [39]
 
234
    procedure ExpectElement(AOwner: TDOMNode);
 
235
    function  ParseReference(AOwner: TDOMNode): Boolean;                // [67]
 
236
    procedure ExpectReference(AOwner: TDOMNode);
 
237
    function  ParsePEReference: Boolean;                                // [69]
 
238
    function  ParseExternalID: Boolean;                                 // [75]
 
239
    procedure ExpectExternalID;
 
240
    function  ParseEncodingDecl: String;                                // [80]
 
241
    procedure SkipEncodingDecl;
 
242
 
 
243
    procedure ResolveEntities(RootNode: TDOMNode);
 
244
  public
 
245
    doc: TDOMDocument;
 
246
    procedure ProcessXML(ABuf: PChar; const AFilename: String);  // [1]
 
247
    procedure ProcessFragment(AOwner: TDOMNode; ABuf: PChar; const AFilename: String);
 
248
    procedure ProcessDTD(ABuf: PChar; const AFilename: String);  // ([29])
 
249
  end;
 
250
 
 
251
{ TXMLReaderDocument }
 
252
 
 
253
procedure TXMLReaderDocument.SetDocType(ADocType: TDOMDocumentType);
 
254
begin
 
255
  FDocType := ADocType;
 
256
end;
 
257
 
 
258
 
 
259
constructor TXMLReaderDocumentType.Create(ADocument: TXMLReaderDocument);
 
260
begin
 
261
  inherited Create(ADocument);
 
262
end;
 
263
 
 
264
function TXMLReader.BufPosToLineCol(p: PChar): TPoint;
 
265
var
 
266
  apos: PChar;
 
267
  x: Integer;
 
268
  y: Integer;
 
269
begin
 
270
  // find out the line in which the error occured
 
271
  apos := BufStart;
 
272
  x := 1;
 
273
  y := 1;
 
274
  while apos < p do begin
 
275
    if apos^ in [#10,#13] then begin
 
276
      Inc(y);
 
277
      x := 1;
 
278
      if (apos[1] in [#10,#13]) and (apos[0]<>apos[1]) then
 
279
        inc(apos);
 
280
    end else
 
281
      Inc(x);
 
282
    Inc(apos);
 
283
  end;
 
284
  Result.X:=X;
 
285
  Result.Y:=Y;
 
286
end;
 
287
 
 
288
function TXMLReader.BufPosToStr(p: PChar): string;
 
289
var
 
290
  LineCol: TPoint;
 
291
begin
 
292
  if p<BufStart then
 
293
    p:=BufStart;
 
294
  // find out the line in which the error occured
 
295
  LineCol:=BufPosToLineCol(p);
 
296
  Result:=IntToStr(LineCol.y)+','+IntToStr(LineCol.x);
 
297
end;
 
298
 
 
299
procedure TXMLReader.RaiseExc(const descr: String);
 
300
var
 
301
  Err: EXMLReadError;
 
302
  LineCol: TPoint;
 
303
begin
 
304
  LineCol:=BufPosToLineCol(buf);
 
305
  Err:=EXMLReadError.Create(
 
306
    Filename+'('+IntToStr(LineCol.y)+','+IntToStr(LineCol.x)+') Error: ' + descr);
 
307
  Err.Position:=buf-BufStart;
 
308
  Err.LineCol:=LineCol;
 
309
  Err.Descr:=descr;
 
310
  raise Err;
 
311
end;
 
312
 
 
313
procedure TXMLReader.RaiseCharNotFound(c: char);
 
314
begin
 
315
  RaiseExc('Expected "' + c + '", found "' + buf^ + '"');
 
316
end;
 
317
 
 
318
function TXMLReader.SkipWhitespace: Boolean;
 
319
begin
 
320
  Result := False;
 
321
  while buf[0] in WhitespaceChars do
 
322
  begin
 
323
    Inc(buf);
 
324
    Result := True;
 
325
  end;
 
326
end;
 
327
 
 
328
procedure TXMLReader.ExpectWhitespace;
 
329
begin
 
330
  if not SkipWhitespace then
 
331
    RaiseExc('Expected whitespace');
 
332
end;
 
333
 
 
334
procedure TXMLReader.ExpectChar(c: char);
 
335
begin
 
336
  if buf^ <> c then
 
337
    RaiseCharNotFound(c);
 
338
  Inc(buf);
 
339
end;
 
340
 
 
341
procedure TXMLReader.ExpectString(const s: String);
 
342
 
 
343
  procedure RaiseStringNotFound;
 
344
  var
 
345
    s2: PChar;
 
346
    s3: String;
 
347
  begin
 
348
    GetMem(s2, Length(s) + 1);
 
349
    StrLCopy(s2, buf, Length(s));
 
350
    s3 := StrPas(s2);
 
351
    FreeMem(s2);
 
352
    RaiseExc('Expected "' + s + '", found "' + s3 + '"');
 
353
  end;
 
354
 
 
355
var
 
356
  i: Integer;
 
357
begin
 
358
  for i := 1 to Length(s) do
 
359
    if buf[i - 1] <> s[i] then begin
 
360
      RaiseStringNotFound;
 
361
    end;
 
362
  Inc(buf, Length(s));
 
363
end;
 
364
 
 
365
function TXMLReader.CheckFor(s: PChar): Boolean;
 
366
begin
 
367
  if buf[0] <> #0 then begin
 
368
    if (buf[0]=s[0]) and (CompareLPChar(buf, s, StrLen(s))) then begin
 
369
      Inc(buf, StrLen(s));
 
370
      Result := True;
 
371
    end else
 
372
      Result := False;
 
373
  end else begin
 
374
    Result := False;
 
375
  end;
 
376
end;
 
377
 
 
378
function TXMLReader.CheckForChar(c: Char): Boolean;
 
379
begin
 
380
  if (buf[0]=c) and (c<>#0) then begin
 
381
    inc(buf);
 
382
    Result:=true;
 
383
  end else begin
 
384
    Result:=false;
 
385
  end;
 
386
end;
 
387
 
 
388
procedure TXMLReader.SkipString(const ValidChars: TSetOfChar);
 
389
begin
 
390
  while buf[0] in ValidChars do begin
 
391
    Inc(buf);
 
392
  end;
 
393
end;
 
394
 
 
395
function TXMLReader.GetString(const ValidChars: TSetOfChar): String;
 
396
var
 
397
  OldBuf: PChar;
 
398
  i, len: integer;
 
399
begin
 
400
  OldBuf:=Buf;
 
401
  while buf[0] in ValidChars do begin
 
402
    Inc(buf);
 
403
  end;
 
404
  len:=buf-OldBuf;
 
405
  SetLength(Result, Len);
 
406
  for i:=1 to len do begin
 
407
    Result[i]:=OldBuf[0];
 
408
    inc(OldBuf);
 
409
  end;
 
410
end;
 
411
 
 
412
function TXMLReader.GetString(BufPos: PChar; Len: integer): string;
 
413
var i: integer;
 
414
begin
 
415
  SetLength(Result,Len);
 
416
  for i:=1 to Len do begin
 
417
    Result[i]:=BufPos[0];
 
418
    inc(BufPos);
 
419
  end;
 
420
end;
 
421
 
 
422
procedure TXMLReader.ProcessXML(ABuf: PChar; const AFilename: String);    // [1]
 
423
begin
 
424
  buf := ABuf;
 
425
  BufStart := ABuf;
 
426
  Filename := AFilename;
 
427
 
 
428
  doc := TXMLReaderDocument.Create;
 
429
  ExpectProlog;
 
430
  {$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLReader.ProcessXML A');{$ENDIF}
 
431
  ExpectElement(doc);
 
432
  {$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLReader.ProcessXML B');{$ENDIF}
 
433
  ParseMisc(doc);
 
434
 
 
435
  // skip end of file characters
 
436
  while buf^=#26 do inc(buf);
 
437
  // check if whole document was read
 
438
  if buf[0] <> #0 then
 
439
    RaiseExc('Text after end of document element found');
 
440
end;
 
441
 
 
442
procedure TXMLReader.ProcessFragment(AOwner: TDOMNode; ABuf: PChar; const AFilename: String);
 
443
begin
 
444
  buf := ABuf;
 
445
  BufStart := ABuf;
 
446
  Filename := AFilename;
 
447
 
 
448
  // do not call SkipWhitespace. They are needed by ParseCharData.
 
449
  while ParseCharData(AOwner) or ParseCDSect(AOwner) or ParsePI or
 
450
    ParseComment(AOwner) or ParseElement(AOwner) or
 
451
    ParseReference(AOwner)
 
452
  do ;
 
453
end;
 
454
 
 
455
function TXMLReader.CheckName: Boolean;
 
456
var OldBuf: PChar;
 
457
begin
 
458
  if not (buf[0] in (Letter + ['_', ':'])) then begin
 
459
    Result := False;
 
460
    exit;
 
461
  end;
 
462
 
 
463
  OldBuf := buf;
 
464
  Inc(buf);
 
465
  SkipString(Letter + ['0'..'9', '.', '-', '_', ':']);
 
466
  buf := OldBuf;
 
467
  Result := True;
 
468
end;
 
469
 
 
470
function TXMLReader.GetName(out s: String): Boolean;    // [5]
 
471
var OldBuf: PChar;
 
472
begin
 
473
  if not (buf[0] in (Letter + ['_', ':'])) then begin
 
474
    SetLength(s, 0);
 
475
    Result := False;
 
476
    exit;
 
477
  end;
 
478
 
 
479
  OldBuf := buf;
 
480
  Inc(buf);
 
481
  SkipString(Letter + ['0'..'9', '.', '-', '_', ':']);
 
482
  s := GetString(OldBuf,buf-OldBuf);
 
483
  Result := True;
 
484
end;
 
485
 
 
486
function TXMLReader.ExpectName: String;    // [5]
 
487
 
 
488
  procedure RaiseNameNotFound;
 
489
  begin
 
490
    RaiseExc('Expected letter, "_" or ":" for name, found "' + buf[0] + '"');
 
491
  end;
 
492
 
 
493
var OldBuf: PChar;
 
494
begin
 
495
  if not (buf[0] in (Letter + ['_', ':'])) then
 
496
    RaiseNameNotFound;
 
497
 
 
498
  OldBuf := buf;
 
499
  Inc(buf);
 
500
  SkipString(Letter + ['0'..'9', '.', '-', '_', ':']);
 
501
  Result:=GetString(OldBuf,buf-OldBuf);
 
502
end;
 
503
 
 
504
procedure TXMLReader.SkipName;
 
505
 
 
506
  procedure RaiseSkipNameNotFound;
 
507
  begin
 
508
    RaiseExc('Expected letter, "_" or ":" for name, found "' + buf[0] + '"');
 
509
  end;
 
510
 
 
511
begin
 
512
  if not (buf[0] in (Letter + ['_', ':'])) then
 
513
    RaiseSkipNameNotFound;
 
514
 
 
515
  Inc(buf);
 
516
  SkipString(Letter + ['0'..'9', '.', '-', '_', ':']);
 
517
end;
 
518
 
 
519
procedure TXMLReader.ExpectAttValue(attr: TDOMAttr);    // [10]
 
520
var
 
521
  OldBuf: PChar;
 
522
 
 
523
  procedure FlushStringBuffer;
 
524
  var
 
525
    s: String;
 
526
  begin
 
527
    if OldBuf<>buf then begin
 
528
      s := GetString(OldBuf,buf-OldBuf);
 
529
      OldBuf := buf;
 
530
      attr.AppendChild(doc.CreateTextNode(s));
 
531
      SetLength(s, 0);
 
532
    end;
 
533
  end;
 
534
 
 
535
var
 
536
  StrDel: char;
 
537
begin
 
538
  if (buf[0] <> '''') and (buf[0] <> '"') then
 
539
    RaiseExc('Expected quotation marks');
 
540
  StrDel:=buf[0];
 
541
  Inc(buf);
 
542
  OldBuf := buf;
 
543
  while (buf[0]<>StrDel) and (buf[0]<>#0) do begin
 
544
    if buf[0] <> '&' then begin
 
545
      Inc(buf);
 
546
    end else
 
547
    begin
 
548
      if OldBuf<>buf then FlushStringBuffer;
 
549
      ParseReference(attr);
 
550
      OldBuf := buf;
 
551
    end;
 
552
  end;
 
553
  if OldBuf<>buf then FlushStringBuffer;
 
554
  inc(buf);
 
555
  ResolveEntities(Attr);
 
556
end;
 
557
 
 
558
function TXMLReader.ExpectPubidLiteral: String;
 
559
begin
 
560
  SetLength(Result, 0);
 
561
  if CheckForChar('''') then begin
 
562
    SkipString(PubidChars - ['''']);
 
563
    ExpectChar('''');
 
564
  end else if CheckForChar('"') then begin
 
565
    SkipString(PubidChars - ['"']);
 
566
    ExpectChar('"');
 
567
  end else
 
568
    RaiseExc('Expected quotation marks');
 
569
end;
 
570
 
 
571
procedure TXMLReader.SkipPubidLiteral;
 
572
begin
 
573
  if CheckForChar('''') then begin
 
574
    SkipString(PubidChars - ['''']);
 
575
    ExpectChar('''');
 
576
  end else if CheckForChar('"') then begin
 
577
    SkipString(PubidChars - ['"']);
 
578
    ExpectChar('"');
 
579
  end else
 
580
    RaiseExc('Expected quotation marks');
 
581
end;
 
582
 
 
583
function TXMLReader.ParseComment(AOwner: TDOMNode): Boolean;    // [15]
 
584
var
 
585
  comment: String;
 
586
  OldBuf: PChar;
 
587
begin
 
588
  if CheckFor('<!--') then begin
 
589
    OldBuf := buf;
 
590
    while (buf[0] <> #0) and (buf[1] <> #0) and
 
591
      ((buf[0] <> '-') or (buf[1] <> '-')) do begin
 
592
      Inc(buf);
 
593
    end;
 
594
    comment:=GetString(OldBuf,buf-OldBuf);
 
595
    AOwner.AppendChild(doc.CreateComment(comment));
 
596
    ExpectString('-->');
 
597
    Result := True;
 
598
  end else
 
599
    Result := False;
 
600
end;
 
601
 
 
602
function TXMLReader.ParsePI: Boolean;    // [16]
 
603
begin
 
604
  if CheckFor('<?') then begin
 
605
    if CompareLIPChar(buf,'XML ',4) then
 
606
      RaiseExc('"<?xml" processing instruction not allowed here');
 
607
    SkipName;
 
608
    if SkipWhitespace then
 
609
      while (buf[0] <> #0) and (buf[1] <> #0) and not
 
610
        ((buf[0] = '?') and (buf[1] = '>')) do Inc(buf);
 
611
    ExpectString('?>');
 
612
    Result := True;
 
613
  end else
 
614
    Result := False;
 
615
end;
 
616
 
 
617
procedure TXMLReader.ExpectProlog;    // [22]
 
618
 
 
619
  procedure ParseVersionNum;
 
620
  begin
 
621
    if doc.InheritsFrom(TXMLDocument) then
 
622
      TXMLDocument(doc).XMLVersion :=
 
623
      GetString(['a'..'z', 'A'..'Z', '0'..'9', '_', '.', ':', '-']);
 
624
  end;
 
625
 
 
626
  procedure ParseDoctypeDecls;
 
627
  begin
 
628
    repeat
 
629
      SkipWhitespace;
 
630
    until not (ParseMarkupDecl or ParsePEReference);
 
631
    ExpectChar(']');
 
632
  end;
 
633
 
 
634
 
 
635
var
 
636
  DocType: TXMLReaderDocumentType;
 
637
 
 
638
begin
 
639
  if CheckFor('<?xml') then
 
640
  begin
 
641
    // '<?xml' VersionInfo EncodingDecl? SDDecl? S? '?>'
 
642
 
 
643
    // VersionInfo: S 'version' Eq (' VersionNum ' | " VersionNum ")
 
644
    SkipWhitespace;
 
645
    ExpectString('version');
 
646
    ParseEq;
 
647
    if buf[0] = '''' then
 
648
    begin
 
649
      Inc(buf);
 
650
      ParseVersionNum;
 
651
      ExpectChar('''');
 
652
    end else if buf[0] = '"' then
 
653
    begin
 
654
      Inc(buf);
 
655
      ParseVersionNum;
 
656
      ExpectChar('"');
 
657
    end else
 
658
      RaiseExc('Expected single or double quotation mark');
 
659
 
 
660
    // EncodingDecl?
 
661
    SkipEncodingDecl;
 
662
 
 
663
    // SDDecl?
 
664
    SkipWhitespace;
 
665
    if CheckFor('standalone') then
 
666
    begin
 
667
      ExpectEq;
 
668
      if buf[0] = '''' then
 
669
      begin
 
670
        Inc(buf);
 
671
        if not (CheckFor('yes''') or CheckFor('no''')) then
 
672
          RaiseExc('Expected ''yes'' or ''no''');
 
673
      end else if buf[0] = '''' then
 
674
      begin
 
675
        Inc(buf);
 
676
        if not (CheckFor('yes"') or CheckFor('no"')) then
 
677
          RaiseExc('Expected "yes" or "no"');
 
678
      end;
 
679
      SkipWhitespace;
 
680
    end;
 
681
 
 
682
    ExpectString('?>');
 
683
  end;
 
684
 
 
685
  // Check for "Misc*"
 
686
  ParseMisc(doc);
 
687
 
 
688
  // Check for "(doctypedecl Misc*)?"    [28]
 
689
  if CheckFor('<!DOCTYPE') then
 
690
  begin
 
691
    DocType := TXMLReaderDocumentType.Create(doc as TXMLReaderDocument);
 
692
    if doc.InheritsFrom(TXMLReaderDocument) then
 
693
      TXMLReaderDocument(doc).SetDocType(DocType);
 
694
    SkipWhitespace;
 
695
    DocType.Name := ExpectName;
 
696
    SkipWhitespace;
 
697
    if CheckForChar('[') then
 
698
    begin
 
699
      ParseDoctypeDecls;
 
700
      SkipWhitespace;
 
701
      ExpectChar('>');
 
702
    end else if not CheckForChar('>') then
 
703
    begin
 
704
      ParseExternalID;
 
705
      SkipWhitespace;
 
706
      if CheckForChar('[') then
 
707
      begin
 
708
        ParseDoctypeDecls;
 
709
        SkipWhitespace;
 
710
      end;
 
711
      ExpectChar('>');
 
712
    end;
 
713
    ParseMisc(doc);
 
714
  end;
 
715
end;
 
716
 
 
717
function TXMLReader.ParseEq: Boolean;    // [25]
 
718
var
 
719
  savedbuf: PChar;
 
720
begin
 
721
  savedbuf := buf;
 
722
  SkipWhitespace;
 
723
  if buf[0] = '=' then begin
 
724
    Inc(buf);
 
725
    SkipWhitespace;
 
726
    Result := True;
 
727
  end else begin
 
728
    buf := savedbuf;
 
729
    Result := False;
 
730
  end;
 
731
end;
 
732
 
 
733
procedure TXMLReader.ExpectEq;
 
734
begin
 
735
  if not ParseEq then
 
736
    RaiseExc('Expected "="');
 
737
end;
 
738
 
 
739
 
 
740
// Parse "Misc*":
 
741
//   Misc ::= Comment | PI | S
 
742
 
 
743
procedure TXMLReader.ParseMisc(AOwner: TDOMNode);    // [27]
 
744
begin
 
745
  repeat
 
746
    SkipWhitespace;
 
747
  until not (ParseComment(AOwner) or ParsePI);
 
748
end;
 
749
 
 
750
function TXMLReader.ParseMarkupDecl: Boolean;    // [29]
 
751
 
 
752
  function ParseElementDecl: Boolean;    // [45]
 
753
 
 
754
    procedure ExpectChoiceOrSeq;    // [49], [50]
 
755
 
 
756
      procedure ExpectCP;    // [48]
 
757
      begin
 
758
        if CheckForChar('(') then
 
759
          ExpectChoiceOrSeq
 
760
        else
 
761
          SkipName;
 
762
        if CheckForChar('?') then
 
763
        else if CheckForChar('*') then
 
764
        else if CheckForChar('+') then;
 
765
      end;
 
766
 
 
767
    var
 
768
      delimiter: Char;
 
769
    begin
 
770
      SkipWhitespace;
 
771
      ExpectCP;
 
772
      SkipWhitespace;
 
773
      delimiter := #0;
 
774
      while not CheckForChar(')') do begin
 
775
        if delimiter = #0 then begin
 
776
          if (buf[0] = '|') or (buf[0] = ',') then
 
777
            delimiter := buf[0]
 
778
          else
 
779
            RaiseExc('Expected "|" or ","');
 
780
          Inc(buf);
 
781
        end else
 
782
          ExpectChar(delimiter);
 
783
        SkipWhitespace;
 
784
        ExpectCP;
 
785
      end;
 
786
    end;
 
787
 
 
788
  begin
 
789
    if CheckFor('<!ELEMENT') then begin
 
790
      ExpectWhitespace;
 
791
      SkipName;
 
792
      ExpectWhitespace;
 
793
 
 
794
      // Get contentspec [46]
 
795
 
 
796
      if CheckFor('EMPTY') then
 
797
      else if CheckFor('ANY') then
 
798
      else if CheckForChar('(') then begin
 
799
        SkipWhitespace;
 
800
        if CheckFor('#PCDATA') then begin
 
801
          // Parse Mixed section [51]
 
802
          SkipWhitespace;
 
803
          if not CheckForChar(')') then
 
804
            repeat
 
805
              ExpectChar('|');
 
806
              SkipWhitespace;
 
807
              SkipName;
 
808
            until CheckFor(')*');
 
809
        end else begin
 
810
          // Parse Children section [47]
 
811
 
 
812
          ExpectChoiceOrSeq;
 
813
 
 
814
          if CheckForChar('?') then
 
815
          else if CheckForChar('*') then
 
816
          else if CheckForChar('+') then;
 
817
        end;
 
818
      end else
 
819
        RaiseExc('Invalid content specification');
 
820
 
 
821
      SkipWhitespace;
 
822
      ExpectChar('>');
 
823
      Result := True;
 
824
    end else
 
825
      Result := False;
 
826
  end;
 
827
 
 
828
  function ParseAttlistDecl: Boolean;    // [52]
 
829
  var
 
830
    attr: TDOMAttr;
 
831
  begin
 
832
    if CheckFor('<!ATTLIST') then begin
 
833
      ExpectWhitespace;
 
834
      SkipName;
 
835
      SkipWhitespace;
 
836
      while not CheckForChar('>') do begin
 
837
        SkipName;
 
838
        ExpectWhitespace;
 
839
 
 
840
        // Get AttType [54], [55], [56]
 
841
        if CheckFor('CDATA') then
 
842
        else if CheckFor('ID') then
 
843
        else if CheckFor('IDREF') then
 
844
        else if CheckFor('IDREFS') then
 
845
        else if CheckFor('ENTITTY') then
 
846
        else if CheckFor('ENTITIES') then
 
847
        else if CheckFor('NMTOKEN') then
 
848
        else if CheckFor('NMTOKENS') then
 
849
        else if CheckFor('NOTATION') then begin   // [57], [58]
 
850
          ExpectWhitespace;
 
851
          ExpectChar('(');
 
852
          SkipWhitespace;
 
853
          SkipName;
 
854
          SkipWhitespace;
 
855
          while not CheckForChar(')') do begin
 
856
            ExpectChar('|');
 
857
            SkipWhitespace;
 
858
            SkipName;
 
859
            SkipWhitespace;
 
860
          end;
 
861
        end else if CheckForChar('(') then begin    // [59]
 
862
          SkipWhitespace;
 
863
          SkipString(Nmtoken);
 
864
          SkipWhitespace;
 
865
          while not CheckForChar(')') do begin
 
866
            ExpectChar('|');
 
867
            SkipWhitespace;
 
868
            SkipString(Nmtoken);
 
869
            SkipWhitespace;
 
870
          end;
 
871
        end else
 
872
          RaiseExc('Invalid tokenized type');
 
873
 
 
874
        ExpectWhitespace;
 
875
 
 
876
        // Get DefaultDecl [60]
 
877
        if CheckFor('#REQUIRED') then
 
878
        else if CheckFor('#IMPLIED') then
 
879
        else begin
 
880
          if CheckFor('#FIXED') then
 
881
            SkipWhitespace;
 
882
          attr := doc.CreateAttribute('');
 
883
          ExpectAttValue(attr);
 
884
        end;
 
885
 
 
886
        SkipWhitespace;
 
887
      end;
 
888
      Result := True;
 
889
    end else
 
890
      Result := False;
 
891
  end;
 
892
 
 
893
  function ParseEntityDecl: Boolean;    // [70]
 
894
  var
 
895
    NewEntity: TDOMEntity;
 
896
 
 
897
    function ParseEntityValue: Boolean;    // [9]
 
898
    var
 
899
      strdel: Char;
 
900
    begin
 
901
      if (buf[0] <> '''') and (buf[0] <> '"') then begin
 
902
        Result := False;
 
903
        exit;
 
904
      end;
 
905
      strdel := buf[0];
 
906
      Inc(buf);
 
907
      while not CheckForChar(strdel) do
 
908
        if ParsePEReference then
 
909
        else if ParseReference(NewEntity) then
 
910
        else begin
 
911
          Inc(buf);             // Normal haracter
 
912
        end;
 
913
      Result := True;
 
914
    end;
 
915
 
 
916
  begin
 
917
    if CheckFor('<!ENTITY') then begin
 
918
      ExpectWhitespace;
 
919
      if CheckForChar('%') then begin    // [72]
 
920
        ExpectWhitespace;
 
921
        NewEntity := doc.CreateEntity(ExpectName);
 
922
        ExpectWhitespace;
 
923
        // Get PEDef [74]
 
924
        if ParseEntityValue then
 
925
        else if ParseExternalID then
 
926
        else
 
927
          RaiseExc('Expected entity value or external ID');
 
928
      end else begin    // [71]
 
929
        NewEntity := doc.CreateEntity(ExpectName);
 
930
        ExpectWhitespace;
 
931
        // Get EntityDef [73]
 
932
        if ParseEntityValue then
 
933
        else begin
 
934
          ExpectExternalID;
 
935
          // Get NDataDecl [76]
 
936
          ExpectWhitespace;
 
937
          ExpectString('NDATA');
 
938
          ExpectWhitespace;
 
939
          SkipName;
 
940
        end;
 
941
      end;
 
942
      SkipWhitespace;
 
943
      ExpectChar('>');
 
944
      Result := True;
 
945
    end else
 
946
      Result := False;
 
947
  end;
 
948
 
 
949
  function ParseNotationDecl: Boolean;    // [82]
 
950
  begin
 
951
    if CheckFor('<!NOTATION') then begin
 
952
      ExpectWhitespace;
 
953
      SkipName;
 
954
      ExpectWhitespace;
 
955
      if ParseExternalID then
 
956
      else if CheckFor('PUBLIC') then begin    // [83]
 
957
        ExpectWhitespace;
 
958
        SkipPubidLiteral;
 
959
      end else
 
960
        RaiseExc('Expected external or public ID');
 
961
      SkipWhitespace;
 
962
      ExpectChar('>');
 
963
      Result := True;
 
964
    end else
 
965
      Result := False;
 
966
  end;
 
967
 
 
968
begin
 
969
  Result := False;
 
970
  while ParseElementDecl or ParseAttlistDecl or ParseEntityDecl or
 
971
    ParseNotationDecl or ParsePI or ParseComment(doc) or SkipWhitespace do
 
972
    Result := True;
 
973
end;
 
974
 
 
975
procedure TXMLReader.ProcessDTD(ABuf: PChar; const AFilename: String);
 
976
begin
 
977
  buf := ABuf;
 
978
  BufStart := ABuf;
 
979
  Filename := AFilename;
 
980
 
 
981
  doc := TXMLReaderDocument.Create;
 
982
  ParseMarkupDecl;
 
983
 
 
984
  {
 
985
  if buf[0] <> #0 then begin
 
986
    DebugLn('=== Unparsed: ===');
 
987
    //DebugLn(buf);
 
988
    DebugLn(StrLen(buf), ' chars');
 
989
  end;
 
990
  }
 
991
end;
 
992
 
 
993
function TXMLReader.ParseCharData(AOwner: TDOMNode): Boolean;    // [14]
 
994
var
 
995
  p: PChar;
 
996
  DataLen: integer;
 
997
  OldBuf: PChar;
 
998
begin
 
999
  OldBuf := buf;
 
1000
  while not (buf[0] in [#0, '<', '&']) do
 
1001
    begin
 
1002
      Inc(buf);
 
1003
    end;
 
1004
  DataLen:=buf-OldBuf;
 
1005
  if DataLen > 0 then
 
1006
    begin
 
1007
      // Check if chardata has non-whitespace content
 
1008
      p:=OldBuf;
 
1009
      while (p<buf) and (p[0] in WhitespaceChars) do
 
1010
        inc(p);
 
1011
      if p<buf then
 
1012
        AOwner.AppendChild(doc.CreateTextNode(GetString(OldBuf,DataLen)));
 
1013
      Result := True;
 
1014
    end
 
1015
  else
 
1016
    Result := False;
 
1017
end;
 
1018
 
 
1019
function TXMLReader.ParseCDSect(AOwner: TDOMNode): Boolean;    // [18]
 
1020
var
 
1021
  OldBuf: PChar;
 
1022
begin
 
1023
  if CheckFor('<![CDATA[') then
 
1024
    begin
 
1025
      OldBuf := buf;
 
1026
      while not CheckFor(']]>') do
 
1027
      begin
 
1028
        Inc(buf);
 
1029
      end;
 
1030
      AOwner.AppendChild(doc.CreateCDATASection(GetString(OldBuf,buf-OldBuf-3))); { Copy CDATA, discarding terminator }
 
1031
      Result := True;
 
1032
    end
 
1033
  else
 
1034
    Result := False;
 
1035
end;
 
1036
 
 
1037
function TXMLReader.ParseElement(AOwner: TDOMNode): Boolean;    // [39] [40] [44]
 
1038
var
 
1039
  NewElem: TDOMElement;
 
1040
 
 
1041
  procedure CreateNameElement;
 
1042
  var
 
1043
    IsEmpty: Boolean;
 
1044
    attr: TDOMAttr;
 
1045
    name: string;
 
1046
    FoundName: String;
 
1047
    StartPos: PChar;
 
1048
  begin
 
1049
    {$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('  CreateNameElement A');{$ENDIF}
 
1050
    StartPos:=buf;
 
1051
    GetName(name);
 
1052
    NewElem := doc.CreateElement(name);
 
1053
    AOwner.AppendChild(NewElem);
 
1054
 
 
1055
    SkipWhitespace;
 
1056
    IsEmpty := False;
 
1057
    while True do
 
1058
    begin
 
1059
      {$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('  CreateNameElement E');{$ENDIF}
 
1060
      if CheckFor('/>') then
 
1061
      begin
 
1062
        IsEmpty := True;
 
1063
        break;
 
1064
      end;
 
1065
      if CheckForChar('>') then
 
1066
        break;
 
1067
 
 
1068
      // Get Attribute [41]
 
1069
      attr := doc.CreateAttribute(ExpectName);
 
1070
      NewElem.Attributes.SetNamedItem(attr);
 
1071
      ExpectEq;
 
1072
      ExpectAttValue(attr);
 
1073
 
 
1074
      SkipWhitespace;
 
1075
    end;
 
1076
 
 
1077
    if not IsEmpty then
 
1078
    begin
 
1079
      // Get content
 
1080
      SkipWhitespace;
 
1081
      while ParseCharData(NewElem) or ParseCDSect(NewElem) or ParsePI or
 
1082
        ParseComment(NewElem) or ParseElement(NewElem) or
 
1083
        ParseReference(NewElem) do;
 
1084
 
 
1085
      // Get ETag [42]
 
1086
      ExpectString('</');
 
1087
      FoundName:=ExpectName;
 
1088
      if FoundName <> name then
 
1089
        RaiseExc('Unmatching element end tag (expected "</' + name + '>", found "</'+FoundName+'>", start tag at '+BufPosToStr(StartPos)+')');
 
1090
      SkipWhitespace;
 
1091
      ExpectChar('>');
 
1092
    end;
 
1093
 
 
1094
    {$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('  CreateNameElement END');{$ENDIF}
 
1095
    ResolveEntities(NewElem);
 
1096
  end;
 
1097
 
 
1098
var
 
1099
  OldBuf: PChar;
 
1100
begin
 
1101
  OldBuf := Buf;
 
1102
  if CheckForChar('<') then
 
1103
  begin
 
1104
    {$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLReader.ParseElement A');{$ENDIF}
 
1105
    if not CheckName then
 
1106
    begin
 
1107
      Buf := OldBuf;
 
1108
      Result := False;
 
1109
    end else begin
 
1110
      CreateNameElement;
 
1111
      Result := True;
 
1112
    end;
 
1113
  end else
 
1114
    Result := False;
 
1115
  {$IFDEF MEM_CHECK}CheckHeapWrtMemCnt('TXMLReader.ParseElement END');{$ENDIF}
 
1116
end;
 
1117
 
 
1118
procedure TXMLReader.ExpectElement(AOwner: TDOMNode);
 
1119
begin
 
1120
  if not ParseElement(AOwner) then
 
1121
    RaiseExc('Expected element');
 
1122
end;
 
1123
 
 
1124
function TXMLReader.ParsePEReference: Boolean;    // [69]
 
1125
begin
 
1126
  if CheckForChar('%') then begin
 
1127
    SkipName;
 
1128
    ExpectChar(';');
 
1129
    Result := True;
 
1130
  end else
 
1131
    Result := False;
 
1132
end;
 
1133
 
 
1134
function TXMLReader.ParseReference(AOwner: TDOMNode): Boolean;    // [67] [68]
 
1135
begin
 
1136
  if not CheckForChar('&') then begin
 
1137
    Result := False;
 
1138
    exit;
 
1139
  end;
 
1140
  if CheckForChar('#') then begin    // Test for CharRef [66]
 
1141
    if CheckForChar('x') then begin
 
1142
      // !!!: there must be at least one digit
 
1143
      while buf[0] in ['0'..'9', 'a'..'f', 'A'..'F'] do Inc(buf);
 
1144
    end else
 
1145
      // !!!: there must be at least one digit
 
1146
      while buf[0] in ['0'..'9'] do Inc(buf);
 
1147
  end else
 
1148
    AOwner.AppendChild(doc.CreateEntityReference(ExpectName));
 
1149
  ExpectChar(';');
 
1150
  Result := True;
 
1151
end;
 
1152
 
 
1153
procedure TXMLReader.ExpectReference(AOwner: TDOMNode);
 
1154
begin
 
1155
  if not ParseReference(AOwner) then
 
1156
    RaiseExc('Expected reference ("&Name;" or "%Name;")');
 
1157
end;
 
1158
 
 
1159
 
 
1160
function TXMLReader.ParseExternalID: Boolean;    // [75]
 
1161
 
 
1162
  function GetSystemLiteral: String;
 
1163
  var
 
1164
    OldBuf: PChar;
 
1165
  begin
 
1166
    if buf[0] = '''' then begin
 
1167
      Inc(buf);
 
1168
      OldBuf := buf;
 
1169
      while (buf[0] <> '''') and (buf[0] <> #0) do begin
 
1170
        Inc(buf);
 
1171
      end;
 
1172
      Result := GetString(OldBuf,buf-OldBuf);
 
1173
      ExpectChar('''');
 
1174
    end else if buf[0] = '"' then begin
 
1175
      Inc(buf);
 
1176
      OldBuf := buf;
 
1177
      while (buf[0] <> '"') and (buf[0] <> #0) do begin
 
1178
        Inc(buf);
 
1179
      end;
 
1180
      Result := GetString(OldBuf,buf-OldBuf);
 
1181
      ExpectChar('"');
 
1182
    end else
 
1183
      Result:='';
 
1184
  end;
 
1185
 
 
1186
  procedure SkipSystemLiteral;
 
1187
  begin
 
1188
    if buf[0] = '''' then begin
 
1189
      Inc(buf);
 
1190
      while (buf[0] <> '''') and (buf[0] <> #0) do begin
 
1191
        Inc(buf);
 
1192
      end;
 
1193
      ExpectChar('''');
 
1194
    end else if buf[0] = '"' then begin
 
1195
      Inc(buf);
 
1196
      while (buf[0] <> '"') and (buf[0] <> #0) do begin
 
1197
        Inc(buf);
 
1198
      end;
 
1199
      ExpectChar('"');
 
1200
    end;
 
1201
  end;
 
1202
 
 
1203
begin
 
1204
  if CheckFor('SYSTEM') then begin
 
1205
    ExpectWhitespace;
 
1206
    SkipSystemLiteral;
 
1207
    Result := True;
 
1208
  end else if CheckFor('PUBLIC') then begin
 
1209
    ExpectWhitespace;
 
1210
    SkipPubidLiteral;
 
1211
    ExpectWhitespace;
 
1212
    SkipSystemLiteral;
 
1213
    Result := True;
 
1214
  end else
 
1215
    Result := False;
 
1216
end;
 
1217
 
 
1218
procedure TXMLReader.ExpectExternalID;
 
1219
begin
 
1220
  if not ParseExternalID then
 
1221
    RaiseExc('Expected external ID');
 
1222
end;
 
1223
 
 
1224
function TXMLReader.ParseEncodingDecl: String;    // [80]
 
1225
 
 
1226
  function ParseEncName: String;
 
1227
  var OldBuf: PChar;
 
1228
  begin
 
1229
    if not (buf[0] in ['A'..'Z', 'a'..'z']) then
 
1230
      RaiseExc('Expected character (A-Z, a-z)');
 
1231
    OldBuf := buf;
 
1232
    Inc(buf);
 
1233
    SkipString(['A'..'Z', 'a'..'z', '0'..'9', '.', '_', '-']);
 
1234
    Result := GetString(OldBuf,buf-OldBuf);
 
1235
  end;
 
1236
 
 
1237
begin
 
1238
  SetLength(Result, 0);
 
1239
  SkipWhitespace;
 
1240
  if CheckFor('encoding') then begin
 
1241
    ExpectEq;
 
1242
    if buf[0] = '''' then begin
 
1243
      Inc(buf);
 
1244
      Result := ParseEncName;
 
1245
      ExpectChar('''');
 
1246
    end else if buf[0] = '"' then begin
 
1247
      Inc(buf);
 
1248
      Result := ParseEncName;
 
1249
      ExpectChar('"');
 
1250
    end;
 
1251
  end;
 
1252
end;
 
1253
 
 
1254
procedure TXMLReader.SkipEncodingDecl;
 
1255
 
 
1256
  procedure ParseEncName;
 
1257
  begin
 
1258
    if not (buf[0] in ['A'..'Z', 'a'..'z']) then
 
1259
      RaiseExc('Expected character (A-Z, a-z)');
 
1260
    Inc(buf);
 
1261
    SkipString(['A'..'Z', 'a'..'z', '0'..'9', '.', '_', '-']);
 
1262
  end;
 
1263
 
 
1264
begin
 
1265
  SkipWhitespace;
 
1266
  if CheckFor('encoding') then begin
 
1267
    ExpectEq;
 
1268
    if buf[0] = '''' then begin
 
1269
      Inc(buf);
 
1270
      ParseEncName;
 
1271
      ExpectChar('''');
 
1272
    end else if buf[0] = '"' then begin
 
1273
      Inc(buf);
 
1274
      ParseEncName;
 
1275
      ExpectChar('"');
 
1276
    end;
 
1277
  end;
 
1278
end;
 
1279
 
 
1280
 
 
1281
{ Currently, this method will only resolve the entities which are
 
1282
  predefined in XML: }
 
1283
 
 
1284
procedure TXMLReader.ResolveEntities(RootNode: TDOMNode);
 
1285
var
 
1286
  Node, NextNode: TDOMNode;
 
1287
 
 
1288
  procedure ReplaceEntityRef(EntityNode: TDOMNode; const Replacement: String);
 
1289
  var
 
1290
    PrevSibling, NextSibling: TDOMNode;
 
1291
  begin
 
1292
    PrevSibling := EntityNode.PreviousSibling;
 
1293
    NextSibling := EntityNode.NextSibling;
 
1294
    if Assigned(PrevSibling) and (PrevSibling.NodeType = TEXT_NODE) then
 
1295
    begin
 
1296
      TDOMCharacterData(PrevSibling).AppendData(Replacement);
 
1297
      RootNode.RemoveChild(EntityNode);
 
1298
      if Assigned(NextSibling) and (NextSibling.NodeType = TEXT_NODE) then
 
1299
      begin
 
1300
        NextNode := NextSibling.NextSibling;
 
1301
        TDOMCharacterData(PrevSibling).AppendData(
 
1302
        TDOMCharacterData(NextSibling).Data);
 
1303
        RootNode.RemoveChild(NextSibling);
 
1304
      end
 
1305
    end else
 
1306
      if Assigned(NextSibling) and (NextSibling.NodeType = TEXT_NODE) then
 
1307
      begin
 
1308
        TDOMCharacterData(NextSibling).InsertData(0, Replacement);
 
1309
        RootNode.RemoveChild(EntityNode);
 
1310
      end else
 
1311
        RootNode.ReplaceChild(Doc.CreateTextNode(Replacement), EntityNode);
 
1312
  end;
 
1313
 
 
1314
begin
 
1315
  Node := RootNode.FirstChild;
 
1316
  while Assigned(Node) do
 
1317
  begin
 
1318
    NextNode := Node.NextSibling;
 
1319
    if Node.NodeType = ENTITY_REFERENCE_NODE then
 
1320
      if Node.NodeName = 'amp' then
 
1321
        ReplaceEntityRef(Node, '&')
 
1322
      else if Node.NodeName = 'apos' then
 
1323
        ReplaceEntityRef(Node, '''')
 
1324
      else if Node.NodeName = 'gt' then
 
1325
        ReplaceEntityRef(Node, '>')
 
1326
      else if Node.NodeName = 'lt' then
 
1327
        ReplaceEntityRef(Node, '<')
 
1328
      else if Node.NodeName = 'quot' then
 
1329
        ReplaceEntityRef(Node, '"');
 
1330
    Node := NextNode;
 
1331
  end;
 
1332
end;
 
1333
 
 
1334
 
 
1335
 
 
1336
procedure ReadXMLFile(out ADoc: TXMLDocument; var f: File);
 
1337
var
 
1338
  reader: TXMLReader;
 
1339
  buf: PChar;
 
1340
  BufSize: Int64;
 
1341
begin
 
1342
  ADoc := nil;
 
1343
  BufSize := FileSize(f) + 1;
 
1344
  if BufSize <= 1 then
 
1345
    exit;
 
1346
 
 
1347
  GetMem(buf, BufSize);
 
1348
  try
 
1349
    BlockRead(f, buf^, BufSize - 1);
 
1350
    buf[BufSize - 1] := #0;
 
1351
    Reader := TXMLReader.Create;
 
1352
    try
 
1353
      Reader.ProcessXML(buf, TFileRec(f).name);
 
1354
    finally
 
1355
      ADoc := TXMLDocument(Reader.doc);
 
1356
      Reader.Free;
 
1357
    end;
 
1358
  finally
 
1359
    FreeMem(buf);
 
1360
  end;
 
1361
end;
 
1362
 
 
1363
procedure ReadXMLFile(out ADoc: TXMLDocument; f: TStream; const AFilename: String);
 
1364
var
 
1365
  reader: TXMLReader;
 
1366
  buf: PChar;
 
1367
begin
 
1368
  ADoc := nil;
 
1369
  if f.Size = 0 then exit;
 
1370
 
 
1371
  GetMem(buf, f.Size + 1);
 
1372
  try
 
1373
    f.Read(buf^, f.Size);
 
1374
    buf[f.Size] := #0;
 
1375
    Reader := TXMLReader.Create;
 
1376
    try
 
1377
      Reader.ProcessXML(buf, AFilename);
 
1378
    finally
 
1379
      ADoc := TXMLDocument(Reader.doc);
 
1380
      Reader.Free;
 
1381
    end;
 
1382
  finally
 
1383
    FreeMem(buf);
 
1384
  end;
 
1385
end;
 
1386
 
 
1387
procedure ReadXMLFile(out ADoc: TXMLDocument; f: TStream);
 
1388
begin
 
1389
  ReadXMLFile(ADoc, f, '<Stream>');
 
1390
end;
 
1391
 
 
1392
procedure ReadXMLFile(out ADoc: TXMLDocument; const AFilename: String);
 
1393
var
 
1394
  FileStream: TFileStream;
 
1395
  MemStream: TMemoryStream;
 
1396
begin
 
1397
  ADoc := nil;
 
1398
  FileStream := TFileStream.Create(UTF8ToSys(AFilename), fmOpenRead or fmShareDenyWrite);
 
1399
  if FileStream = nil then exit;
 
1400
  MemStream := TMemoryStream.Create;
 
1401
  try
 
1402
    MemStream.LoadFromStream(FileStream);
 
1403
    ReadXMLFile(ADoc, MemStream, AFilename);
 
1404
  finally
 
1405
    FileStream.Free;
 
1406
    MemStream.Free;
 
1407
  end;
 
1408
end;
 
1409
 
 
1410
procedure ReadXMLFragment(AParentNode: TDOMNode; var f: File);
 
1411
var
 
1412
  Reader: TXMLReader;
 
1413
  buf: PChar;
 
1414
  BufSize: Int64;
 
1415
begin
 
1416
  BufSize := FileSize(f) + 1;
 
1417
  if BufSize <= 1 then
 
1418
    exit;
 
1419
 
 
1420
  GetMem(buf, BufSize);
 
1421
  try
 
1422
    BlockRead(f, buf^, BufSize - 1);
 
1423
    buf[BufSize - 1] := #0;
 
1424
    Reader := TXMLReader.Create;
 
1425
    try
 
1426
      Reader.Doc := AParentNode.OwnerDocument;
 
1427
      Reader.ProcessFragment(AParentNode, buf, TFileRec(f).name);
 
1428
    finally
 
1429
      Reader.Free;
 
1430
    end;
 
1431
  finally
 
1432
    FreeMem(buf);
 
1433
  end;
 
1434
end;
 
1435
 
 
1436
procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream; const AFilename: String);
 
1437
var
 
1438
  Reader: TXMLReader;
 
1439
  buf: PChar;
 
1440
begin
 
1441
  if f.Size = 0 then
 
1442
    exit;
 
1443
 
 
1444
  GetMem(buf, f.Size + 1);
 
1445
  try
 
1446
    f.Read(buf^, f.Size);
 
1447
    buf[f.Size] := #0;
 
1448
    Reader := TXMLReader.Create;
 
1449
    Reader.Doc := AParentNode.OwnerDocument;
 
1450
    try
 
1451
      Reader.ProcessFragment(AParentNode, buf, AFilename);
 
1452
    finally
 
1453
      Reader.Free;
 
1454
    end;
 
1455
  finally
 
1456
    FreeMem(buf);
 
1457
  end;
 
1458
end;
 
1459
 
 
1460
procedure ReadXMLFragment(AParentNode: TDOMNode; var f: TStream);
 
1461
begin
 
1462
  ReadXMLFragment(AParentNode, f, '<Stream>');
 
1463
end;
 
1464
 
 
1465
procedure ReadXMLFragment(AParentNode: TDOMNode; const AFilename: String);
 
1466
var
 
1467
  Stream: TStream;
 
1468
begin
 
1469
  Stream := TFileStream.Create(UTF8ToSys(AFilename), fmOpenRead or fmShareDenyWrite);
 
1470
  try
 
1471
    ReadXMLFragment(AParentNode, Stream, AFilename);
 
1472
  finally
 
1473
    Stream.Free;
 
1474
  end;
 
1475
end;
 
1476
 
 
1477
 
 
1478
procedure ReadDTDFile(var ADoc: TXMLDocument; var f: File);
 
1479
var
 
1480
  Reader: TXMLReader;
 
1481
  buf: PChar;
 
1482
  BufSize: Int64;
 
1483
begin
 
1484
  ADoc := nil;
 
1485
  BufSize := FileSize(f) + 1;
 
1486
  if BufSize <= 1 then
 
1487
    exit;
 
1488
 
 
1489
  GetMem(buf, BufSize);
 
1490
  try
 
1491
    BlockRead(f, buf^, BufSize - 1);
 
1492
    buf[BufSize - 1] := #0;
 
1493
    Reader := TXMLReader.Create;
 
1494
    try
 
1495
      Reader.ProcessDTD(buf, TFileRec(f).name);
 
1496
      ADoc := TXMLDocument(Reader.doc);
 
1497
    finally
 
1498
      Reader.Free;
 
1499
    end;
 
1500
  finally
 
1501
    FreeMem(buf);
 
1502
  end;
 
1503
end;
 
1504
 
 
1505
procedure ReadDTDFile(var ADoc: TXMLDocument; var f: TStream; const AFilename: String);
 
1506
var
 
1507
  Reader: TXMLReader;
 
1508
  buf: PChar;
 
1509
begin
 
1510
  ADoc := nil;
 
1511
  if f.Size = 0 then
 
1512
    exit;
 
1513
 
 
1514
  GetMem(buf, f.Size + 1);
 
1515
  try
 
1516
    f.Read(buf^, f.Size);
 
1517
    buf[f.Size] := #0;
 
1518
    Reader := TXMLReader.Create;
 
1519
    try
 
1520
      Reader.ProcessDTD(buf, AFilename);
 
1521
      ADoc := TXMLDocument(Reader.doc);
 
1522
    finally
 
1523
      Reader.Free;
 
1524
    end;
 
1525
  finally
 
1526
    FreeMem(buf);
 
1527
  end;
 
1528
end;
 
1529
 
 
1530
procedure ReadDTDFile(var ADoc: TXMLDocument; var f: TStream);
 
1531
begin
 
1532
  ReadDTDFile(ADoc, f, '<Stream>');
 
1533
end;
 
1534
 
 
1535
procedure ReadDTDFile(var ADoc: TXMLDocument; const AFilename: String);
 
1536
var
 
1537
  Stream: TStream;
 
1538
begin
 
1539
  ADoc := nil;
 
1540
  Stream := TFileStream.Create(UTF8ToSys(AFilename), fmOpenRead or fmShareDenyWrite);
 
1541
  try
 
1542
    ReadDTDFile(ADoc, Stream, AFilename);
 
1543
  finally
 
1544
    Stream.Free;
 
1545
  end;
 
1546
end;
 
1547
 
 
1548
 
 
1549
end.