← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fcl/xml/sax_html.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fcl/xml/sax_html.pp
1
 
{
2
 
    $Id: sax_html.pp,v 1.5 2003/03/16 22:38:09 sg Exp $
3
 
    This file is part of the Free Component Library
4
 
 
5
 
    HTML parser with SAX-like interface
6
 
    Copyright (c) 2000-2002 by
7
 
      Areca Systems GmbH / Sebastian Guenther, sg@freepascal.org
8
 
 
9
 
    See the file COPYING.FPC, included in this distribution,
10
 
    for details about the copyright.
11
 
 
12
 
    This program is distributed in the hope that it will be useful,
13
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
14
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
15
 
 
16
 
 **********************************************************************}
17
 
 
18
 
 
19
 
{
20
 
  Known problems:
21
 
  * The whitespace handling does only work for processing the DOM tree.
22
 
    Storing the DOM tree to a XML file will result in a quite ugly file.
23
 
    (This probably has got much better with recent versions, which do
24
 
    decent whitespace converting, but it's not tested really good.)
25
 
  * Entity references in attribute values don't get parsed.
26
 
}
27
 
 
28
 
 
29
 
unit SAX_HTML;
30
 
 
31
 
interface
32
 
 
33
 
uses SysUtils, Classes, SAX, DOM, DOM_HTML;
34
 
 
35
 
type
36
 
 
37
 
{ THTMLReader: The HTML reader class }
38
 
 
39
 
  THTMLScannerContext = (
40
 
    scUnknown,
41
 
    scWhitespace,       // within whitespace
42
 
    scText,             // within text
43
 
    scEntityReference,  // within entity reference ("&...;")
44
 
    scTag);             // within a start tag or end tag
45
 
 
46
 
  THTMLReader = class(TSAXReader)
47
 
  private
48
 
    FStarted: Boolean;
49
 
    FEndOfStream: Boolean;
50
 
    FScannerContext: THTMLScannerContext;
51
 
    FTokenText: SAXString;
52
 
    FCurStringValueDelimiter: Char;
53
 
    FAttrNameRead: Boolean;
54
 
  protected
55
 
    procedure EnterNewScannerContext(NewContext: THTMLScannerContext);
56
 
  public
57
 
    constructor Create;
58
 
    destructor Destroy; override;
59
 
 
60
 
    procedure Parse(AInput: TSAXInputSource); override; overload;
61
 
 
62
 
    property EndOfStream: Boolean read FEndOfStream;
63
 
    property ScannerContext: THTMLScannerContext read FScannerContext;
64
 
    property TokenText: SAXString read FTokenText;
65
 
  end;
66
 
 
67
 
 
68
 
{ THTMLToDOMConverter }
69
 
 
70
 
  THTMLNodeType = (ntWhitespace, ntText, ntEntityReference, ntTag);
71
 
 
72
 
  THTMLNodeInfo = class
73
 
    NodeType: THTMLNodeType;
74
 
    DOMNode: TDOMNode;
75
 
  end;
76
 
 
77
 
  THTMLToDOMConverter = class
78
 
  private
79
 
    FReader: THTMLReader;
80
 
    FDocument: TDOMDocument;
81
 
    FElementStack: TList;
82
 
    FNodeBuffer: TList;
83
 
    IsFragmentMode, FragmentRootSet: Boolean;
84
 
    FragmentRoot: TDOMNode;
85
 
 
86
 
    procedure ReaderCharacters(Sender: TObject; const ch: PSAXChar;
87
 
      Start, Count: Integer);
88
 
    procedure ReaderIgnorableWhitespace(Sender: TObject; const ch: PSAXChar;
89
 
      Start, Count: Integer);
90
 
    procedure ReaderSkippedEntity(Sender: TObject; const Name: SAXString);
91
 
    procedure ReaderStartElement(Sender: TObject;
92
 
      const NamespaceURI, LocalName, RawName: SAXString; Attr: TSAXAttributes);
93
 
    procedure ReaderEndElement(Sender: TObject;
94
 
      const NamespaceURI, LocalName, RawName: SAXString);
95
 
 
96
 
  public
97
 
    constructor Create(AReader: THTMLReader; ADocument: TDOMDocument);
98
 
    constructor CreateFragment(AReader: THTMLReader; AFragmentRoot: TDOMNode);
99
 
    destructor Destroy; override;
100
 
  end;
101
 
 
102
 
 
103
 
// Helper functions; these ones are HTML equivalents of ReadXML[File|Fragment]
104
 
 
105
 
procedure ReadHTMLFile(var ADoc: THTMLDocument; const AFilename: String);
106
 
procedure ReadHTMLFile(var ADoc: THTMLDocument; var f: TStream);
107
 
 
108
 
procedure ReadHTMLFragment(AParentNode: TDOMNode; const AFilename: String);
109
 
procedure ReadHTMLFragment(AParentNode: TDOMNode; var f: TStream);
110
 
 
111
 
 
112
 
 
113
 
implementation
114
 
 
115
 
uses HTMLDefs;
116
 
 
117
 
const
118
 
  WhitespaceChars = [#9, #10, #13, ' '];
119
 
 
120
 
 
121
 
constructor THTMLReader.Create;
122
 
begin
123
 
  inherited Create;
124
 
  FScannerContext := scUnknown;
125
 
end;
126
 
 
127
 
destructor THTMLReader.Destroy;
128
 
begin
129
 
  if FStarted then
130
 
    DoEndDocument;
131
 
  inherited Destroy;
132
 
end;
133
 
 
134
 
procedure THTMLReader.Parse(AInput: TSAXInputSource);
135
 
const
136
 
  MaxBufferSize = 1024;
137
 
var
138
 
  Buffer: array[0..MaxBufferSize - 1] of Char;
139
 
  BufferSize, BufferPos: Integer;
140
 
begin
141
 
  if not FStarted then
142
 
  begin
143
 
    FStarted := True;
144
 
    DoStartDocument;
145
 
  end;
146
 
 
147
 
  FEndOfStream := False;
148
 
  while True do
149
 
  begin
150
 
    // Read data into the input buffer
151
 
    BufferSize := AInput.Stream.Read(Buffer, MaxBufferSize);
152
 
    if BufferSize = 0 then
153
 
    begin
154
 
      FEndOfStream := True;
155
 
      break;
156
 
    end;
157
 
 
158
 
    BufferPos := 0;
159
 
    while BufferPos < BufferSize do
160
 
      case ScannerContext of
161
 
        scUnknown:
162
 
          case Buffer[BufferPos] of
163
 
            #9, #10, #13, ' ':
164
 
              EnterNewScannerContext(scWhitespace);
165
 
            '&':
166
 
              begin
167
 
                Inc(BufferPos);
168
 
                EnterNewScannerContext(scEntityReference);
169
 
              end;
170
 
            '<':
171
 
              begin
172
 
                Inc(BufferPos);
173
 
                EnterNewScannerContext(scTag);
174
 
              end;
175
 
            else
176
 
              EnterNewScannerContext(scText);
177
 
          end;
178
 
        scWhitespace:
179
 
          case Buffer[BufferPos] of
180
 
            #9, #10, #13, ' ':
181
 
              begin
182
 
                FTokenText := FTokenText + Buffer[BufferPos];
183
 
                Inc(BufferPos);
184
 
              end;
185
 
            '&':
186
 
              begin
187
 
                Inc(BufferPos);
188
 
                EnterNewScannerContext(scEntityReference);
189
 
              end;
190
 
            '<':
191
 
              begin
192
 
                Inc(BufferPos);
193
 
                EnterNewScannerContext(scTag);
194
 
              end;
195
 
            else
196
 
              EnterNewScannerContext(scText);
197
 
          end;
198
 
        scText:
199
 
          case Buffer[BufferPos] of
200
 
            #9, #10, #13, ' ':
201
 
              EnterNewScannerContext(scWhitespace);
202
 
            '&':
203
 
              begin
204
 
                Inc(BufferPos);
205
 
                EnterNewScannerContext(scEntityReference);
206
 
              end;
207
 
            '<':
208
 
              begin
209
 
                Inc(BufferPos);
210
 
                EnterNewScannerContext(scTag);
211
 
              end;
212
 
            else
213
 
            begin
214
 
              FTokenText := FTokenText + Buffer[BufferPos];
215
 
              Inc(BufferPos);
216
 
            end;
217
 
          end;
218
 
        scEntityReference:
219
 
          if Buffer[BufferPos] = ';' then
220
 
          begin
221
 
            Inc(BufferPos);
222
 
            EnterNewScannerContext(scUnknown);
223
 
          end else if not (Buffer[BufferPos] in
224
 
            ['a'..'z', 'A'..'Z', '0'..'9', '#']) then
225
 
            EnterNewScannerContext(scUnknown)
226
 
          else
227
 
          begin
228
 
            FTokenText := FTokenText + Buffer[BufferPos];
229
 
            Inc(BufferPos);
230
 
          end;
231
 
        scTag:
232
 
          case Buffer[BufferPos] of
233
 
            '''', '"':
234
 
              begin
235
 
                if FAttrNameRead then
236
 
                begin
237
 
                  if FCurStringValueDelimiter = #0 then
238
 
                    FCurStringValueDelimiter := Buffer[BufferPos]
239
 
                  else if FCurStringValueDelimiter = Buffer[BufferPos] then
240
 
                  begin
241
 
                    FCurStringValueDelimiter := #0;
242
 
                    FAttrNameRead := False;
243
 
                  end;
244
 
                end;
245
 
                FTokenText := FTokenText + Buffer[BufferPos];
246
 
                Inc(BufferPos);
247
 
              end;
248
 
            '=':
249
 
              begin
250
 
                FAttrNameRead := True;
251
 
                FTokenText := FTokenText + Buffer[BufferPos];
252
 
                Inc(BufferPos);
253
 
              end;
254
 
            '>':
255
 
              begin
256
 
                Inc(BufferPos);
257
 
                if FCurStringValueDelimiter = #0 then
258
 
                  EnterNewScannerContext(scUnknown);
259
 
              end;
260
 
            else
261
 
            begin
262
 
              FTokenText := FTokenText + Buffer[BufferPos];
263
 
              Inc(BufferPos);
264
 
            end;
265
 
          end;
266
 
      end;
267
 
  end;
268
 
end;
269
 
 
270
 
procedure THTMLReader.EnterNewScannerContext(NewContext: THTMLScannerContext);
271
 
 
272
 
  function SplitTagString(const s: String; var Attr: TSAXAttributes): String;
273
 
  var
274
 
    i, j: Integer;
275
 
    AttrName: String;
276
 
    ValueDelimiter: Char;
277
 
    DoIncJ: Boolean;
278
 
  begin
279
 
    Attr := nil;
280
 
    i := Pos(' ', s);
281
 
    if i <= 0 then
282
 
      Result := LowerCase(s)
283
 
    else
284
 
    begin
285
 
      Result := LowerCase(Copy(s, 1, i - 1));
286
 
      Attr := TSAXAttributes.Create;
287
 
 
288
 
      Inc(i);
289
 
 
290
 
      while (i <= Length(s)) and (s[i] in WhitespaceChars) do
291
 
        Inc(i);
292
 
 
293
 
      SetLength(AttrName, 0);
294
 
      j := i;
295
 
 
296
 
      while j <= Length(s) do
297
 
        if s[j] = '=' then
298
 
        begin
299
 
          AttrName := LowerCase(Copy(s, i, j - i));
300
 
          Inc(j);
301
 
          if (j < Length(s)) and ((s[j] = '''') or (s[j] = '"')) then
302
 
          begin
303
 
            ValueDelimiter := s[j];
304
 
            Inc(j);
305
 
          end else
306
 
            ValueDelimiter := #0;
307
 
          i := j;
308
 
          DoIncJ := False;
309
 
          while j <= Length(s) do
310
 
            if ValueDelimiter = #0 then
311
 
              if s[j] in WhitespaceChars then
312
 
                break
313
 
              else
314
 
                Inc(j)
315
 
            else if s[j] = ValueDelimiter then
316
 
            begin
317
 
              DoIncJ := True;
318
 
              break
319
 
            end else
320
 
              Inc(j);
321
 
 
322
 
          Attr.AddAttribute('', AttrName, '', '', Copy(s, i, j - i));
323
 
 
324
 
          if DoIncJ then
325
 
            Inc(j);
326
 
 
327
 
          while (j <= Length(s)) and (s[j] in WhitespaceChars) do
328
 
            Inc(j);
329
 
          i := j;
330
 
        end
331
 
        else if s[j] in WhitespaceChars then
332
 
        begin
333
 
          Attr.AddAttribute('', Copy(s, i, j - i), '', '', '');
334
 
          Inc(j);
335
 
          while (j <= Length(s)) and (s[j] in WhitespaceChars) do
336
 
            Inc(j);
337
 
          i := j;
338
 
        end else
339
 
          Inc(j);
340
 
    end;
341
 
  end;
342
 
 
343
 
var
344
 
  Attr: TSAXAttributes;
345
 
  EntString, TagName: String;
346
 
  Found: Boolean;
347
 
  Ent: Char;
348
 
  i: Integer;
349
 
begin
350
 
  case ScannerContext of
351
 
    scWhitespace:
352
 
      DoIgnorableWhitespace(PSAXChar(TokenText), 1, Length(TokenText));
353
 
    scText:
354
 
      DoCharacters(PSAXChar(TokenText), 0, Length(TokenText));
355
 
    scEntityReference:
356
 
      begin
357
 
        if ResolveHTMLEntityReference(TokenText, Ent) then
358
 
        begin
359
 
          EntString := Ent;
360
 
          DoCharacters(PSAXChar(EntString), 0, 1);
361
 
        end else
362
 
        begin
363
 
          { Is this a predefined Unicode character entity? We must check this,
364
 
            as undefined entities must be handled as text, for compatiblity
365
 
            to popular browsers... }
366
 
          Found := False;
367
 
          for i := Low(UnicodeHTMLEntities) to High(UnicodeHTMLEntities) do
368
 
            if UnicodeHTMLEntities[i] = TokenText then
369
 
            begin
370
 
              Found := True;
371
 
              break;
372
 
            end;
373
 
          if Found then
374
 
            DoSkippedEntity(TokenText)
375
 
          else
376
 
            DoCharacters(PSAXChar('&' + TokenText), 0, Length(TokenText) + 1);
377
 
        end;
378
 
      end;
379
 
    scTag:
380
 
      if Length(TokenText) > 0 then
381
 
      begin
382
 
        Attr := nil;
383
 
        if TokenText[1] = '/' then
384
 
        begin
385
 
          DoEndElement('',
386
 
            SplitTagString(Copy(TokenText, 2, Length(TokenText)), Attr), '');
387
 
        end else if TokenText[1] <> '!' then
388
 
        begin
389
 
          // Do NOT combine to a single line, as Attr is an output value!
390
 
          TagName := SplitTagString(TokenText, Attr);
391
 
          DoStartElement('', TagName, '', Attr);
392
 
        end;
393
 
        if Assigned(Attr) then
394
 
          Attr.Free;
395
 
      end;
396
 
  end;
397
 
  FScannerContext := NewContext;
398
 
  SetLength(FTokenText, 0);
399
 
  FCurStringValueDelimiter := #0;
400
 
  FAttrNameRead := False;
401
 
end;
402
 
 
403
 
 
404
 
{ THTMLToDOMConverter }
405
 
 
406
 
constructor THTMLToDOMConverter.Create(AReader: THTMLReader;
407
 
  ADocument: TDOMDocument);
408
 
begin
409
 
  inherited Create;
410
 
  FReader := AReader;
411
 
  FReader.OnCharacters := @ReaderCharacters;
412
 
  FReader.OnIgnorableWhitespace := @ReaderIgnorableWhitespace;
413
 
  FReader.OnSkippedEntity := @ReaderSkippedEntity;
414
 
  FReader.OnStartElement := @ReaderStartElement;
415
 
  FReader.OnEndElement := @ReaderEndElement;
416
 
  FDocument := ADocument;
417
 
  FElementStack := TList.Create;
418
 
  FNodeBuffer := TList.Create;
419
 
end;
420
 
 
421
 
constructor THTMLToDOMConverter.CreateFragment(AReader: THTMLReader;
422
 
  AFragmentRoot: TDOMNode);
423
 
begin
424
 
  inherited Create;
425
 
  FReader := AReader;
426
 
  FReader.OnCharacters := @ReaderCharacters;
427
 
  FReader.OnIgnorableWhitespace := @ReaderIgnorableWhitespace;
428
 
  FReader.OnSkippedEntity := @ReaderSkippedEntity;
429
 
  FReader.OnStartElement := @ReaderStartElement;
430
 
  FReader.OnEndElement := @ReaderEndElement;
431
 
  FDocument := AFragmentRoot.OwnerDocument;
432
 
  FElementStack := TList.Create;
433
 
  FNodeBuffer := TList.Create;
434
 
  FragmentRoot := AFragmentRoot;
435
 
  IsFragmentMode := True;
436
 
end;
437
 
 
438
 
destructor THTMLToDOMConverter.Destroy;
439
 
var
440
 
  i: Integer;
441
 
begin
442
 
  // Theoretically, always exactly one item will remain - the root element:
443
 
  for i := 0 to FNodeBuffer.Count - 1 do
444
 
    THTMLNodeInfo(FNodeBuffer[i]).Free;
445
 
  FNodeBuffer.Free;
446
 
 
447
 
  FElementStack.Free;
448
 
  inherited Destroy;
449
 
end;
450
 
 
451
 
procedure THTMLToDOMConverter.ReaderCharacters(Sender: TObject;
452
 
  const ch: PSAXChar; Start, Count: Integer);
453
 
var
454
 
  s: SAXString;
455
 
  NodeInfo: THTMLNodeInfo;
456
 
begin
457
 
  SetLength(s, Count);
458
 
  Move(ch^, s[1], Count * SizeOf(SAXChar));
459
 
 
460
 
  NodeInfo := THTMLNodeInfo.Create;
461
 
  NodeInfo.NodeType := ntText;
462
 
  NodeInfo.DOMNode := FDocument.CreateTextNode(s);
463
 
  FNodeBuffer.Add(NodeInfo);
464
 
end;
465
 
 
466
 
procedure THTMLToDOMConverter.ReaderIgnorableWhitespace(Sender: TObject;
467
 
  const ch: PSAXChar; Start, Count: Integer);
468
 
var
469
 
  s: SAXString;
470
 
  NodeInfo: THTMLNodeInfo;
471
 
begin
472
 
  SetLength(s, Count);
473
 
  Move(ch^, s[1], Count * SizeOf(SAXChar));
474
 
 
475
 
  NodeInfo := THTMLNodeInfo.Create;
476
 
  NodeInfo.NodeType := ntWhitespace;
477
 
  NodeInfo.DOMNode := FDocument.CreateTextNode(s);
478
 
  FNodeBuffer.Add(NodeInfo);
479
 
end;
480
 
 
481
 
procedure THTMLToDOMConverter.ReaderSkippedEntity(Sender: TObject;
482
 
  const Name: SAXString);
483
 
var
484
 
  NodeInfo: THTMLNodeInfo;
485
 
begin
486
 
  NodeInfo := THTMLNodeInfo.Create;
487
 
  NodeInfo.NodeType := ntEntityReference;
488
 
  NodeInfo.DOMNode := FDocument.CreateEntityReference(Name);
489
 
  FNodeBuffer.Add(NodeInfo);
490
 
end;
491
 
 
492
 
procedure THTMLToDOMConverter.ReaderStartElement(Sender: TObject;
493
 
  const NamespaceURI, LocalName, RawName: SAXString; Attr: TSAXAttributes);
494
 
var
495
 
  NodeInfo: THTMLNodeInfo;
496
 
  Element: TDOMElement;
497
 
  i: Integer;
498
 
begin
499
 
  // WriteLn('Start: ', LocalName, '. Node buffer before: ', FNodeBuffer.Count, ' elements');
500
 
  Element := FDocument.CreateElement(LocalName);
501
 
  if Assigned(Attr) then
502
 
  begin
503
 
    // WriteLn('Attribute: ', Attr.GetLength);
504
 
    for i := 0 to Attr.GetLength - 1 do
505
 
    begin
506
 
      // WriteLn('#', i, ': LocalName = ', Attr.GetLocalName(i), ', Value = ', Attr.GetValue(i));
507
 
      Element[Attr.GetLocalName(i)] := Attr.GetValue(i);
508
 
    end;
509
 
  end;
510
 
 
511
 
  NodeInfo := THTMLNodeInfo.Create;
512
 
  NodeInfo.NodeType := ntTag;
513
 
  NodeInfo.DOMNode := Element;
514
 
  if IsFragmentMode then
515
 
  begin
516
 
    if not FragmentRootSet then
517
 
    begin
518
 
      FragmentRoot.AppendChild(Element);
519
 
      FragmentRootSet := True;
520
 
    end;
521
 
  end else
522
 
    if not Assigned(FDocument.DocumentElement) then
523
 
      FDocument.AppendChild(Element);
524
 
  FNodeBuffer.Add(NodeInfo);
525
 
  // WriteLn('Start: ', LocalName, '. Node buffer after: ', FNodeBuffer.Count, ' elements');
526
 
end;
527
 
 
528
 
procedure THTMLToDOMConverter.ReaderEndElement(Sender: TObject;
529
 
  const NamespaceURI, LocalName, RawName: SAXString);
530
 
var
531
 
  NodeInfo, NodeInfo2: THTMLNodeInfo;
532
 
  i, j: Integer;
533
 
  TagInfo: PHTMLElementProps;
534
 
begin
535
 
  // WriteLn('End: ', LocalName, '. Node buffer: ', FNodeBuffer.Count, ' elements');
536
 
  // Find the matching start tag
537
 
  i := FNodeBuffer.Count - 1;
538
 
  while i >= 0 do
539
 
  begin
540
 
    NodeInfo := THTMLNodeInfo(FNodeBuffer.Items[i]);
541
 
    if (NodeInfo.NodeType = ntTag) and
542
 
      (CompareText(NodeInfo.DOMNode.NodeName, LocalName) = 0) then
543
 
    begin
544
 
      // We found the matching start tag
545
 
 
546
 
      TagInfo := nil;
547
 
      for j := Low(HTMLElProps) to High(HTMLElProps) do
548
 
        if CompareText(HTMLElProps[j].Name, LocalName) = 0 then
549
 
        begin
550
 
          TagInfo := @HTMLElProps[j];
551
 
          break;
552
 
        end;
553
 
 
554
 
      Inc(i);
555
 
      while i < FNodeBuffer.Count do
556
 
      begin
557
 
        NodeInfo2 := THTMLNodeInfo(FNodeBuffer.Items[i]);
558
 
 
559
 
        if (NodeInfo2.NodeType = ntWhitespace) and Assigned(TagInfo) and
560
 
          (not (efPreserveWhitespace in TagInfo^.Flags)) then
561
 
          // Handle whitespace, which doesn't need to get preserved...
562
 
          if not (efPCDATAContent in TagInfo^.Flags) then
563
 
            // No character data allowed within the current element
564
 
            NodeInfo2.DOMNode.Free
565
 
          else
566
 
          begin
567
 
            // Character data allowed, so normalize it
568
 
            NodeInfo2.DOMNode.NodeValue := ' ';
569
 
            NodeInfo.DOMNode.AppendChild(NodeInfo2.DOMNode)
570
 
          end
571
 
        else
572
 
          NodeInfo.DOMNode.AppendChild(NodeInfo2.DOMNode);
573
 
 
574
 
        NodeInfo2.Free;
575
 
        FNodeBuffer.Delete(i);
576
 
      end;
577
 
      break;
578
 
    end;
579
 
    Dec(i);
580
 
  end;
581
 
end;
582
 
 
583
 
 
584
 
procedure ReadHTMLFile(var ADoc: THTMLDocument; const AFilename: String);
585
 
var
586
 
  f: TStream;
587
 
begin
588
 
  ADoc := nil;
589
 
  f := TFileStream.Create(AFilename, fmOpenRead);
590
 
  try
591
 
    ReadHTMLFile(ADoc, f);
592
 
  finally
593
 
    f.Free;
594
 
  end;
595
 
end;
596
 
 
597
 
procedure ReadHTMLFile(var ADoc: THTMLDocument; var f: TStream);
598
 
var
599
 
  Reader: THTMLReader;
600
 
  Converter: THTMLToDOMConverter;
601
 
begin
602
 
  ADoc := THTMLDocument.Create;
603
 
  Reader := THTMLReader.Create;
604
 
  try
605
 
    Converter := THTMLToDOMConverter.Create(Reader, ADoc);
606
 
    try
607
 
      Reader.ParseStream(f);
608
 
    finally
609
 
      Converter.Free;
610
 
    end;
611
 
  finally
612
 
    Reader.Free;
613
 
  end;
614
 
end;
615
 
 
616
 
procedure ReadHTMLFragment(AParentNode: TDOMNode; const AFilename: String);
617
 
var
618
 
  f: TStream;
619
 
begin
620
 
  f := TFileStream.Create(AFilename, fmOpenRead);
621
 
  try
622
 
    ReadHTMLFragment(AParentNode, f);
623
 
  finally
624
 
    f.Free;
625
 
  end;
626
 
end;
627
 
 
628
 
procedure ReadHTMLFragment(AParentNode: TDOMNode; var f: TStream);
629
 
var
630
 
  Reader: THTMLReader;
631
 
  Converter: THTMLToDOMConverter;
632
 
begin
633
 
  Reader := THTMLReader.Create;
634
 
  try
635
 
    Converter := THTMLToDOMConverter.CreateFragment(Reader, AParentNode);
636
 
    try
637
 
      Reader.ParseStream(f);
638
 
    finally
639
 
      Converter.Free;
640
 
    end;
641
 
  finally
642
 
    Reader.Free;
643
 
  end;
644
 
end;
645
 
 
646
 
 
647
 
end.
648
 
 
649
 
 
650
 
{
651
 
  $Log: sax_html.pp,v $
652
 
  Revision 1.5  2003/03/16 22:38:09  sg
653
 
  * Added fragment parsing functions
654
 
 
655
 
  Revision 1.4  2002/12/14 19:18:21  sg
656
 
  * Improved whitespace handling (although it's still not perfect in all
657
 
    cases)
658
 
 
659
 
  Revision 1.3  2002/12/12 20:17:32  sg
660
 
  * More WideString fixes
661
 
 
662
 
  Revision 1.2  2002/12/12 13:43:38  michael
663
 
  + Patches from peter to fix 1.1 compile
664
 
 
665
 
  Revision 1.1  2002/12/11 21:06:07  sg
666
 
  * Small cleanups
667
 
  * Replaced htmldoc unit with dom_html unit
668
 
  * Added SAX parser framework and SAX HTML parser
669
 
 
670
 
}