1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
|
program htmlwithsax;
uses sysutils, classes, sax,sax_html, custapp;
Type
{ TMyApp }
TMyApp = Class(TCustomApplication)
Private
Indent : string;
procedure DoEndDocument(Sender: TObject);
procedure DoEndElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString);
procedure DoFile(const aFileName: String);
procedure DoStartDocument(Sender: TObject);
procedure DoStartElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString; Atts: TSAXAttributes);
Protected
Procedure DoRun; override;
end;
{ TMyApp }
procedure TMyApp.DoFile(const aFileName : String);
var
F : TFileStream;
MyReader : THTMLReader;
begin
MyReader:=Nil;
F:=TFileStream.Create(aFileName,fmOpenRead or fmShareDenyWrite);
try
MyReader:=THTMLReader.Create;
MyReader.OnStartDocument:=@DoStartDocument;
MyReader.OnStartElement:=@DoStartElement;
MyReader.OnEndElement:=@DoEndElement;
MyReader.OnEndDocument:=@DoEndDocument;
MyReader.ParseStream(F);
finally
FreeAndNil(MyReader);
F.Free;
end;
end;
procedure TMyApp.DoRun;
var
I : Integer;
begin
StopOnException:=True;
Terminate;
if ParamCount<1 then
begin
Writeln('Usage : ',ExtractFileName(ExeName),' <htmlfile1> [htmlfile2 [htmlfile3]]');
Exit;
end;
for I:=1 to ParamCount do
DoFile(Params[i]);
end;
procedure TMyApp.DoStartDocument(Sender: TObject);
begin
Writeln('Document start');
Indent:='';
end;
procedure TMyApp.DoEndElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString);
begin
Indent:=Copy(Indent,1,Length(Indent)-2);
end;
procedure TMyApp.DoEndDocument(Sender: TObject);
begin
Writeln('Document end');
Indent:='';
end;
procedure TMyApp.DoStartElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString; Atts: TSAXAttributes);
Var
I : Integer;
S : unicodestring;
begin
S:='';
if Assigned(Atts) then
for I:=0 to Atts.Length-1 do
begin
if S<>'' then S:=S+', ';
S:=S+Atts.LocalNames[i];
end;
Write(Indent,'Tag: <',LocalName,'>');
if NameSpaceURI<>'' then
Write(' xmlns: ',NameSpaceURI);
if QName<>'' then
Write(', full tag: ',QName);
If S<>'' then
Write(', attrs: ',S);
Writeln;
Indent:=Indent+' ';
end;
begin
With TMyApp.Create(Nil) do
try
Initialize;
Run;
finally
Free;
end;
end.
|
