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;
end;


function EnumChildWndProc(hWindow: hWnd; lPar: TList):Boolean; Stdcall;
begin
  Result := True;

  //子ウィンドウのタイトルがウェブペ?`ジを表示しているウィンドウだっら?仕鹘K了
  if GetWindowClassNameStr(hWindow) = 'Internet Explorer_Server' then begin
    //そのハンドル??を引数のlParに返す
    lPar.Add(Pointer(hWindow));
  end;
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;
        end;
      end;

    end;
  finally
    FreeAndNil(AList);
  end;
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;
end.

相关阅读 >>

Delphi环境下基于spcomm控件开发串口通讯报文字节丢失的问题解决

Delphi 把mp3做背景音乐

Delphi firemonkey限制tedit只能输入数字的完美方法

截取程序的网络封包(Delphi hook api)

dll 的静态调用实例代码

Delphi tstringbuilder详解

Delphi upload 上传文件

Delphi操作unicode字符

Delphi parent属性的另类用法

Delphi 运行js

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...

    暂无评论...