delphi 实现如何枚举所有打开的IE选项卡

unit Unit1;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

ListBox1: TListBox;

ListBox2: TListBox;

Button2: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private }

public

{ Public }

end;

var

Form1: TForm1;

implementation

uses SHDocVw, oleacc, MSHTML, ActiveX;

{$R *.dfm}

function GetWindowClassNameStr(hWindow: HWND): String;

var

Buffer : array[0..MAX_PATH - 1] of Char;

Len : Integer;

begin

FillChar(Buffer, SizeOf(Buffer), #0);

Len := GetClassName(hWindow, Buffer, Length(Buffer));

if Len > 0 then Result := Buffer else Result := '';

end;

function EnumWindowsProc(hwindow :HWnd; lparam :LPARAM):BOOL; stdcall;

var

PC :PChar;

Len :integer;

Name,AppName :string;

begin

Result :=false;

if hWindow <> 0 then

begin

GetMem(PC, 100);

Len :=GetWindowtext(hWindow, PC, 100);

setstring(Name, PC, Len);

AppName := GetWindowClassNameStr(hWindow);

if (Name <> '') and(AppName = 'IEFrame') then

begin

Form1.ListBox1.Items.Add(inttostr(hWindow)+ ' '+AppName +' '+Name);

end;

Result :=true;

end;

function EnumChildWndProc(hWindow: hWnd; lPar: TList):Boolean; Stdcall;

begin

Result := True;

//子ウィンドウのタイトルがウェブページを表示しているウィンドウだっら検索終了

if GetWindowClassNameStr(hWindow) = 'Internet Explorer_Server' then begin

//そのハンドル値を引数のlParに返す

lPar.Add(Pointer(hWindow));

end;

function getIETab(IEHandle :HWnd):BOOL;

var

AList : TList;

i : Integer;

TabWnd : HWND;

AMsg : Cardinal;

iRes : Cardinal;

pDoc : IHTMLDocument2;

TabIE : IWebbrowser2;

IService : IServiceProvider;

URL : OleVariant;

begin

AList := TList.Create;

try

//タブのウィンドウハンドルを列挙する

//アクティブなタブが最初に検索されるようである

EnumChildWindows(IEHandle, @EnumChildWndProc, LPARAM(AList));

for i := 0 to AList.Count - 1 do begin

TabWnd := Integer(AList.Items[i]);

//WM_HTML_GETOBJECTメッセージのIDを取得

AMsg := RegisterWindowMessage('WM_HTML_GETOBJECT');

//タブウィンドに対して取得メッセージを送る

//この戻り値はドキュメントのポインタ

SendMessageTimeOut(TabWnd, AMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, iRes);

//IWebbrowser2インターフェイスのオブジェクト(TabIE)を取得

if ObjectFromLresult(iRes, IHTMLDocument2, 0, pDoc) = S_OK then begin

IService := pDoc.parentWindow as IServiceprovider;

IService.QueryService(IWebbrowserApp, IWebbrowser2, TabIE);

if TabIE <> nil then begin

//ページのタイトルを表示

Form1.ListBox2.Items.Add(IntToStr(TabWnd)+''+TabIE.LocationName);

//2番目に(2番目のタブとは限らない)検出したタブに指定のURLのページを表示

if i = 1 then begin

URL := 'http://www.embarcadero.com/jp/products/delphi';

//TabIE.Navigate2(URL, 0, EmptyParam, EmptyParam, EmptyParam);

end;

finally

FreeAndNil(AList);

end;

procedure TForm1.Button1Click(Sender: tobject);

var

i:integer;

str,strHWindow:string;

begin

ListBox1.Clear;

ListBox2.Clear;

EnumWindows(@EnumWindowsProc, 0);

for i:= 0 to ListBox1.Items.Count-1 do

begin

str:=ListBox1.Items[i];

strHWindow:= copy(str,1,pos(' ',str)-1);

getIETab(strtoint(strHWindow));

end;

end.

推荐分享