← Back to branch summary

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

« back to all changes in this revision

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