uses
MSHTML;
function DOMNodeClassNameIs (
const Node : IHTMLDOMNode;
const Name :
string) : Boolean;
var
e : IHTMLElement;
begin
e := Node
as IHTMLElement;
if not Assigned (e)
then
Exception.Create ('
Fehlermeldung');
Result := e.className =
Name
end;
function DOMNodeIsTextNode (
const Node : IHTMLDOMNode) : Boolean;
begin
if Assigned (Node)
then
Result := Node.nodeType = 3
else
Result := False
end;
function DOMNodeTagNameIs (
const Node : IHTMLDOMNode;
const Name :
string) : Boolean;
begin
if Assigned (Node)
then
Result := LowerCase (Node.nodeName) = LowerCase (
Name)
else
Result := False
end;
function FindSpanByClassName (Node : IHTMLDOMNode;
const Name :
string) : IHTMLDOMNode;
begin
Result :=
nil;
while Assigned (Node)
do
begin
if (LowerCase (Node.nodeName) = '
span')
and DOMNodeClassNameIs (Node,
Name)
then
begin
Result := Node.firstChild;
Break
end;
Node := Node.nextSibling
end
end;
procedure TForm1.Button1Click(Sender: TObject);
var
d : IHTMLDocument3;
c : IHTMLElementCollection;
i : Integer;
n : IHTMLDOMNode;
s :
string;
procedure AddNodeValue (
const Node : IHTMLDOMNode;
var S :
string);
begin
if not Assigned (Node)
then
Exception.Create ('
Fehlermeldung');
if S <> '
'
then
S := S + '
';
S := S + Node.nodeValue
end;
procedure AddFFTHeader (
const Node : IHTMLDOMNode;
var S :
string);
var
n : IHTMLDOMNode;
procedure AddFFTDateTime (
var Node : IHTMLDOMNode;
var S :
string);
begin
if not DOMNodeIsTextNode (Node)
then
Exception.Create ('
Fehlermeldung');
AddNodeValue (Node, S);
Node := Node.nextSibling
end;
procedure AddFFTSpanByClassName (
var Node : IHTMLDOMNode;
var S :
string;
const Name :
string);
var
n : IHTMLDOMNode;
begin
n := FindSpanByClassName (Node,
Name);
if not Assigned (n)
then
Exception.Create ('
Fehlermeldung');
AddNodeValue (n, S);
Node := Node.nextSibling
end;
begin
n := Node.firstChild;
AddFFTDateTime (n, S);
AddFFTSpanByClassName (n, S, '
FFT_header_for_name');
AddFFTSpanByClassName (n, S, '
FFT_header_group')
end;
procedure AddFFTText (Node : IHTMLDOMNode;
var S :
string);
begin
if not (DOMNodeTagNameIs (Node, '
div')
and DOMNodeClassNameIs (Node, '
fftText'))
then
Exception.Create ('
Fehlermeldung');
Node := Node.firstChild;
if not DOMNodeTagNameIs (Node, '
pre')
then
Exception.Create ('
Fehlermeldung');
Node := Node.firstChild;
if DOMNodeIsTextNode (Node)
then
AddNodeValue (Node, S)
end;
begin
d := WebBrowser1.Document
as IHTMLDocument3;
if not Assigned (d)
then
Exit;
c := d.getElementsByTagName ('
div');
for i := 0
to c.length - 1
do
begin
n := c.item (i, EmptyParam)
as IHTMLDOMNode;
if not Assigned (n)
then
Exception.Create ('
Fehlermeldung');
if DOMNodeClassNameIs (n, '
FFT_header')
then
begin
s := '
';
AddFFTHeader (n, s);
AddFFTText (n.nextSibling, s);
Memo1.Lines.Add (s)
end
end
end;