主要用到的是MSAA(Microsoft Active Accessibility) 函数:ObjectFromLResult,该函数在动态链接库 oleacc.dll 中定义。
uses SHDocVw, MsHtml, ActiveX;
type TObjectFromLResult = function(LRESULT: lResult; const IID: TIID; WPARAM: wParam; out pObject): HRESULT; stdcall;
function GetIEFromHWND(WHandle: HWND; var IE: IWebbrowser2): HRESULT; var hInst: HWND; lRes: Cardinal; MSG: Integer; pDoc: IHTMLDocument2; ObjectFromLresult: TObjectFromLresult; begin Result := S_False; hInst := LoadLibrary('Oleacc.dll'); @ObjectFromLresult := GetProcAddress(hInst, 'ObjectFromLresult'); if @ObjectFromLresult <> nil then begin try MSG := RegisterWindowMessage('WM_HTML_GETOBJECT'); SendMessageTimeOut(WHandle, MSG, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes); Result := ObjectFromLresult(lRes, IHTMLDocument2, 0, pDoc); if Result = S_OK then (pDoc.parentWindow as IServiceprovider).QueryService(IWebbrowserApp, IWebbrowser2, IE); finally FreeLibrary(hInst); end; end; end;
调用例子,以下代码快速关闭所有打开的IE窗口:
procedure TForm1.Button1Click(Sender: TObject); var hCurWindow, hMainWnd, hTabWnd, hCldWnd:HWnd; //窗口句柄 WinClsName:array[0..255] of char; IE1: IWebbrowser2; begin hCurWindow := GetWindow(Handle,GW_HWNDFirst); //获取第一个窗口的句柄 while hCurWindow<>0 do begin GetClassName(hCurWindow, @WinClsName, 255); if String(WinClsName) = 'IEFrame' then begin hMainWnd := hCurWindow; hCldWnd := hCurWindow; hTabWnd := 0; repeat //循环查找所有选项卡 hTabWnd := FindWindowEx(hMainWnd, hTabWnd, 'Frame Tab', nil); if hTabWnd <> 0 then hCldWnd := FindWindowEx(hTabWnd, 0, 'TabWindowClass', nil); if hCldWnd <> 0 then hCldWnd := FindWindowEx(hCldWnd, 0, 'Shell DocObject View', nil); if hCldWnd <> 0 then hCldWnd := FindWindowEx(hCldWnd, 0, 'Internet Explorer_Server', nil); if hCldWnd <> 0 then if GetIEFromHWnd(hCldWnd, IE1) = S_OK then //获取IWebBrowser2 begin IE1.Quit; //关闭IE,也可以执行其他操作,呵呵 end; until hTabWnd = 0; end; hCurWindow:=GetWindow(hCurWindow,GW_HWNDNEXT); //获取下一个窗口的句柄 end; end;
|
请发表评论