VB6 控制IE彈出強制回應視窗

最近一個小項目,開發一個外掛程式,需要對一個第三方系統的網頁內容進行操作.操作的內容還比較複雜.自然選擇用BHO做.

做到一半卡住了,原因在於這個網站有一個showmodal的強制回應視窗,需要對這個彈出的強制回應視窗也進行控制.

但是找遍了DOM和IE的各個介面也沒找到能控制或捕獲快顯視窗內容的東西.

雖然可以重寫快顯視窗的代碼,改用window.open方式彈出,再進行捕獲,但因為那網站的快顯視窗還帶了複雜的參數,不方便轉換,所以保持不能改他的代碼.

既然從IE方向無法下手,就只能改變方向,從Windows視窗方向下手.因為快顯視窗也是視窗,可以進行捕獲快顯視窗控制代碼,然後遍曆出Webbrowser控制控制代碼,再轉換成Document對象.得到Document對象就可以對網頁進行隨意控制了.

關鍵代碼如下:

'BHO類中下勾子hWndRetProcHook = SetWindowsHookEx(HookType.WH_CALLWNDPROCRET, AddressOf modCallback.CallWndRetProc, 0, App.ThreadID)'再手工彈出強制回應視窗.htmlDOM.parentWindow.execScript "btnReNewCard()", "JScript"

此時標準模組中的CallWndRetProc開始工作了,代碼如下(省略部門代碼的聲名):

Public Function CallWndRetProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long    On Error GoTo ErrorLine    Dim hwnd As Long    Dim script As MSHTML.HTMLScriptElement    If code <> 0 Then      CallWndRetProc = CallNextHookEx(hWndRetProcHook, code, wParam, lParam)      Exit Function    End If    CopyMemory hCWPRETSTRUCT, ByVal lParam, LenB(hCWPRETSTRUCT)

    If hCWPRETSTRUCT.Message = WM_PARENTNOTIFY Then        Debug.Print hCWPRETSTRUCT.wParam, hCWPRETSTRUCT.hwnd        If hCWPRETSTRUCT.wParam = WM_CREATE Then            EnumChildWindows hCWPRETSTRUCT.hwnd, AddressOf EnumChildProc, hwnd

'注意到以下代碼都是注釋的,實際項目中已經刪除了,這裡留下只為示範,後面解釋為什麼要注釋掉.'            If hwnd = 0 Then'                MsgBox "擷取瀏覽器資訊失敗,請重試.", vbExclamation'                Exit Function'            End If

'Set NewhtmlDOM = IEDOMFromhWnd(hwnd)'        If Not (NewhtmlDOM Is Nothing) Then'            Set script = NewhtmlDOM.createElement("Script")'            script.Text = "var getCardScript = function(){" & vbCrLf & _'                      "            getScrapCardScript();" & vbCrLf & _'                      "          }" & vbCrLf & _'                      "  var refreshCard =function(){" & vbCrLf & _'                      "              if(hasErrMsg()) {" & vbCrLf & _'                      "                  return;" & vbCrLf & _'                      "              }" & vbCrLf & _'                      "          writeFlag=true;" & vbCrLf & _'                      "              var noticeInfo={};" & vbCrLf & _'                      "              // Comments 欄位在下發時設定具體的錯誤資訊" & vbCrLf & _'                      "              if(writeFlag==true){" & vbCrLf & _'                      "                noticeInfo.Result=""1"";" & vbCrLf & _'                      "                //noticeInfo.Comments=""成功"";" & vbCrLf & _'                      "              }" & vbCrLf & _'                      "              else{" & vbCrLf & _'                      "                noticeInfo.Result=""2"";" & vbCrLf & _'                      "                noticeInfo.ErrorCode=writeFlag;" & vbCrLf & _'                      "                //noticeInfo.Comments=""失敗"";" & vbCrLf & _'                      "              }" & vbCrLf & _'                      "              addBizState(""noticeInfo"",noticeInfo);" & vbCrLf & _'                      "              scrapCardReturnNotice();" & vbCrLf & _'                      "          }"'            script.language = "Javascript"'                'Debug.Print InStr(0, "authKey", htmlDOM.scripts(5).Text, vbTextCompare)'            While NewhtmlDOM.ReadyState <> "complete"'                DoEvents'            Wend'            NewhtmlDOM.body.appendChild script'        Else'            MsgBox "擷取瀏覽對象失敗.", vbExclamation'        End If            'UnhookWindowsHookEx hWndRetProcHook        End If    End If    CallWndRetProc = CallNextHookEx(hWndRetProcHook, code, wParam, lParam)    Exit FunctionErrorLine:    MsgBox "發生異常." & Err.Description, vbCritical    CallWndRetProc = CallNextHookEx(hWndRetProcHook, code, wParam, lParam)End Function

因為IE的ShowModal方法快顯視窗會產生WM_PARENTNOTIFY訊息和WM_Create訊息,所以只對這兩個訊息進行監控.監控到快顯視窗後,就用EnumChildWindows遍曆快顯視窗的所有子視窗,以得到Webbrowser的控制代碼.在上面的代碼中看到,EnumChildWindows後有大片的注釋代碼.

我的原意是想用EnumChildWindows的最後一個參數來輸出EnumWindowProc子程尋找到的Webbrowser控制代碼,我將這個參數聲名為byref.這段代碼在我Win7下運行正常,並且輸出了Webbrowser控制代碼.但是當項目完成後移到WindowsXP測試時,居然無法輸出遍曆得到的控制代碼了.MSDN中沒說這個參數只能輸入不能輸出啊!而且我在Win7下運行相當正確啊,百思不得其解.

一開始以為是user32.dll版本問題,將WIN7的這個檔案複製到XP的DLL和IE根目錄下,問題依舊存在,所以無奈,只能取消用EnumChildWindows返回控制代碼的方式,改在EnumWindowProc子程中處理,於是注釋上上面那段代碼.

另外有注意到,上面代碼中,取消Hook的代碼是單獨一行注釋的,我的本意是,在獲得完Webbrowser控制項後就unhook,這句代碼在WIN7啟動並執行也是相當好,但是轉到XP就不行了,所以也注釋了這行代碼,改到後面unhook.

下面是EnumWindowProc子程.

Function EnumChildProc(ByVal hwnd As Long, ByRef lParam As Long) As Long    Dim script As MSHTML.HTMLScriptElement    If IsIEServerWindow(hwnd) Then        lParam = hwnd

'找到控制代碼後,將控制代碼轉換成Document對象.        Set NewhtmlDOM = IEDOMFromhWnd(hwnd)        If Not (NewhtmlDOM Is Nothing) Then            Set script = NewhtmlDOM.createElement("Script")

'下面重寫網頁中的代碼.

            script.Text = "var getCardScript = function(){" & vbCrLf & _                      "            getScrapCardScript();" & vbCrLf & _                      "          }" & vbCrLf & _                      "  var refreshCard =function(){" & vbCrLf & _                      "              if(hasErrMsg()) {" & vbCrLf & _                      "                  return;" & vbCrLf & _                      "              }" & vbCrLf & _                      "          writeFlag=true;" & vbCrLf & _                      "              var noticeInfo={};" & vbCrLf & _                      "              // Comments 欄位在下發時設定具體的錯誤資訊" & vbCrLf & _                      "              if(writeFlag==true){" & vbCrLf & _                      "                noticeInfo.Result=""1"";" & vbCrLf & _                      "                //noticeInfo.Comments=""成功"";" & vbCrLf & _                      "              }" & vbCrLf & _                      "              else{" & vbCrLf & _                      "                noticeInfo.Result=""2"";" & vbCrLf & _                      "                noticeInfo.ErrorCode=writeFlag;" & vbCrLf & _                      "                //noticeInfo.Comments=""失敗"";" & vbCrLf & _                      "              }" & vbCrLf & _                      "              addBizState(""noticeInfo"",noticeInfo);" & vbCrLf & _                      "              scrapCardReturnNotice();" & vbCrLf & _                      "          }"            script.language = "Javascript"                'Debug.Print InStr(0, "authKey", htmlDOM.scripts(5).Text, vbTextCompare)

'下面這段必不可少.因為獲得控制代碼和Document對象是相當短暫的,網頁根本未載入完全,無法重寫代碼的,所以必須等待網頁載入完成,再重寫頁面代碼.            While NewhtmlDOM.ReadyState <> "complete"                DoEvents            Wend            NewhtmlDOM.body.appendChild script        Else            MsgBox "擷取瀏覽對象失敗.", vbExclamation        End If        EnumChildProc = 0    Else        EnumChildProc = 1    End IfEnd Function

下面貼出控制代碼轉換成Document對象的方法

'判斷是否瀏覽器控制項

Function IsIEServerWindow(ByVal hwnd As Long) As Boolean    '判斷是否是瀏覽器控制項    Dim lRes As Long    Dim sClassName As String    sClassName = String(100, 0)    lRes = GetClassName(hwnd, sClassName, Len(sClassName))    sClassName = Left(sClassName, lRes)    IsIEServerWindow = StrComp(sClassName, "Internet Explorer_Server", vbTextCompare) = 0End FunctionFunction IEDOMFromhWnd(ByRef hwnd As Long) As IHTMLDocument'通過控制代碼得到DOM對象Dim IID_IHTMLDocument As olelib.UUID Dim hWndChild As LongDim lRes As LongDim lMsg As LongDim hr As LongSet IEDOMFromhWnd = NothingIf hwnd <> 0 Then    'If Not IsIEServerWindow(hwnd) Then    '    EnumChildWindows hwnd, AddressOf EnumChildProc, hwnd    'End If    If IsIEServerWindow(hwnd) Then        '註冊訊息        lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")        '發送訊息        SendMessageTimeout hwnd, lMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes        'MsgBox "lRes" & lRes        If lRes Then            With IID_IHTMLDocument                 .Data1 = &H626FC520  '編碼                 .Data2 = &HA41E                 .Data3 = &H11CF                 .Data4(0) = &HA7                 .Data4(1) = &H31                 .Data4(2) = &H0                 .Data4(3) = &HA0                 .Data4(4) = &HC9                 .Data4(5) = &H8                 .Data4(6) = &H26                 .Data4(7) = &H37            End With

            hr = ObjectFromLresult(lRes, IID_IHTMLDocument, 0, IEDOMFromhWnd)            'MsgBox "HR:" & hr        End If    End IfEnd IfEnd Function

這裡利用Active Accessibility組件擷取的Document對象.

通過上面的代碼就完成了對IE彈出模組視窗的控制.其中WIN7和XP下調用API的一些差別讓我走了不少彎路,現在還不明白這些差異是如何產生的,希望瞭解真相的人士指點一二.