Browse Source

* SAX example

git-svn-id: trunk@44293 -
michael 5 years ago
parent
commit
abda57b3b9
2 changed files with 90 additions and 0 deletions
  1. 1 0
      .gitattributes
  2. 89 0
      packages/fcl-xml/examples/htmlwithsax.lpr

+ 1 - 0
.gitattributes

@@ -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 - 0
packages/fcl-xml/examples/htmlwithsax.lpr

@@ -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.
+