本文整理自网络,侵删。
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 firemonkey限制tedit只能输入数字的完美方法
更多相关阅读请进入《Delphi》频道 >>