Loop through frames of a TWebBrowser (Views: 33)
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. |