最近一個小項目,開發一個插件,需要對一個第三方系統的網頁內容進行操作.操作的內容還比較複雜.自然選擇用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 Function
ErrorLine:
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 If
End 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) = 0
End Function
Function IEDOMFromhWnd(ByRef hwnd As Long) As IHTMLDocument
'通過句柄得到DOM對象
Dim IID_IHTMLDocument As olelib.UUID
Dim hWndChild As Long
Dim lRes As Long
Dim lMsg As Long
Dim hr As Long
Set IEDOMFromhWnd = Nothing
If 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 If
End If
End Function
這裏利用Active Accessibility組件獲取的Document對象.通過上面的代碼就完成了對IE彈出模塊窗口的控制.其中WIN7和XP下調用API的一些差別讓我走了不少彎路,現在還不明白這些差異是如何產生的,希望瞭解真相的人士指點一二.