paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-23 20:49:43 +02:00
Code Issues Packages Projects Releases Wiki Activity

* SAX example

Browse Source 
git-svn-id: trunk@44293 -
This commit is contained in:
michael 2020-03-13 08:05:42 +00:00
parent e9ac6799a6
commit abda57b3b9
2 changed files with 90 additions and 0 deletions
.gitattributes
packages/fcl-xml/examples
htmlwithsax.lpr

1
.gitattributes vendored
View File

@ -4633,6 +4633,7 @@ packages/fcl-xml/Makefile.fpc svneol=native#text/plain
packages/fcl-xml/Makefile.fpc.fpcmake svneol=native#text/plain
packages/fcl-xml/buildfclxml.lpi svneol=native#text/plain
packages/fcl-xml/buildfclxml.pp svneol=native#text/plain
packages/fcl-xml/examples/htmlwithsax.lpr svneol=native#text/plain
packages/fcl-xml/examples/reducexml.lpi svneol=native#text/plain
packages/fcl-xml/examples/reducexml.pp svneol=native#text/plain
packages/fcl-xml/examples/test.html svneol=native#text/html

89
packages/fcl-xml/examples/htmlwithsax.lpr Normal file
View File

@ -0,0 +1,89 @@
program htmlwithsax;
uses sysutils, classes, sax,sax_html, custapp;
Type
{ TMyApp }
TMyApp = Class(TCustomApplication)
Private
Indent : string;
MyReader : THTMLReader;
procedure DoEndElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString);
procedure DoStartDocument(Sender: TObject);
procedure DoStartElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString; Atts: TSAXAttributes);
Protected
Procedure DoRun; override;
end;
{ TMyApp }
procedure TMyApp.DoRun;
var
F : TFileStream;
begin
StopOnException:=True;
Terminate;
F:=TFileStream.Create(Params[1],fmOpenRead or fmShareDenyWrite);
try
MyReader:=THTMLReader.Create;
MyReader.OnStartDocument:=@DoStartDocument;
MyReader.OnStartElement:=@DoStartElement;
MyReader.OnEndElement:=@DoEndElement;
MyReader.ParseStream(F);
finally
F.Free;
end;
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.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.