Loop through frames of a TWebBrowser

Problem/Question/Abstract:

Loop through frames of a TWebBrowser

Answer:

Here is the DFM:

object Form1: TForm1
Left = 278
Top = 161
Width = 512
Height = 478
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
WindowState = wsMaximized
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 504
Height = 41
Align = alTop
TabOrder = 0
object Button1: TButton
Left = 8
Top = 8
Width = 75
Height = 25
Caption = 'Close'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 388
Top = 7
Width = 75
Height = 25
Caption = 'LoadURL'
TabOrder = 1
OnClick = Button2Click
end
object edt_url: TEdit
Left = 104
Top = 9
Width = 281
Height = 21
TabOrder = 2
end
end
object Memo: TMemo
Left = 0
Top = 41
Width = 504
Height = 176
Align = alTop
ScrollBars = ssVertical
TabOrder = 1
end
object Browser: TWebBrowser_V1
Left = 0
Top = 217
Width = 504
Height = 215
Align = alClient
TabOrder = 2
OnFrameNavigateComplete = BrowserFrameNavigateComplete
ControlData = {
4C00000017340000391600000000000000000000000000000000000000000000
000000004C000000000000000000000001000000E0D057007335CF11AE690800
2B2E12620C000000000000004C0000000114020000000000C000000000000046
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000100000000000000000000000000000000000000}
end
object StatusBar1: TStatusBar
Left = 0
Top = 432
Width = 504
Height = 19
Panels = <
item
Width = 200
end >
SimplePanel = False
end
end

Here is the source:

unit frmForm1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, SHDocVw_TLB, IEParser, mshtml_tlb, ActiveX, OleCtrls,
ComCtrls;

type
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
Button2: TButton;
Memo: TMemo;
Browser: TWebBrowser_V1;
edt_url: TEdit;
StatusBar1: TStatusBar;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure BrowserFrameNavigateComplete(Sender: TObject;
const URL: WideString);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
close;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if edt_url.text = '' then
exit;
Browser.navigate(edt_url.text);
end;

procedure TForm1.BrowserFrameNavigateComplete(Sender: TObject;
const URL: WideString);
var
Document: IHTMLDocument2;
FrameDoc: IHTMLDocument2;
Frames: IHTMLFramesCollection2;
All: IHtmlElementCollection;
HtmlElement: IHtmlElement;
idisp: IDispatch;
i, j: Integer;
v: OleVariant;
win2: IHTMLWindow2;
str_ready: string;
begin
Memo.Lines.Clear;
Browser.Document.QueryInterface(iHTMLDocument2, Document);
Frames := Document.get_frames;
All := Document.All;
for i := 0 to All.length - 1 do
begin
HTMLElement := All.Item(i, 0) as IHTMLElement;
if (Assigned(HTMLElement)) then
begin
if (HTMLElement.TagName = 'FRAME') then
begin
v := HTMLElement.getAttribute('Name', 0);
Memo.lines.add('============================ FRAME FOUND ==');
Memo.lines.add(' ==>FRAME NAME: ' + v);
idisp := Frames.item(v);
// now we get the window-object
idisp.QueryInterface(IHTMLWindow2, win2);
if (Assigned(win2)) then
begin
// here it comes, the IHTMLDocument2
FrameDoc := win2.document;
if (Assigned(FrameDoc)) then
begin
// we have to wait for the document until it is loaded ...
repeat
application.processmessages;
str_ready := FrameDoc.readyState;
StatusBar1.Panels[0].Text := str_ready;
until (str_ready = 'complete') or (str_ready = 'interactive');
// ...now it is safe to go on with work...
for j := 0 to FrameDoc.all.length - 1 do
begin
// showing the doc.elements for demo purposes
HTMLElement := FrameDoc.All.Item(j, 0) as IHTMLElement;
Memo.lines.add('Element : [' + HTMLElement.TagName + ']');
end;
end;
end;
end;
end;
end;
end;

end.