vb html ie弹出窗口,VB6 控制IE弹出模式窗口

最近一个小项目,开发一个插件,需要对一个第三方系统的网页内容进行操作.操作的内容还比较复杂.自然选择用BHO做.

做到一半卡住了,原因在于这个网站有一个showmodal的模式窗口,需要对这个弹出的模式窗口也进行控制.

但是找遍了DOM和IE的各个接口也没找到能控制或捕获弹出窗口内容的东西.

虽然可以重写弹出窗口的代码,改用window.open方式弹出,再进行捕获,但因为那网站的弹出窗口还带了复杂的参数,不方便转换,所以保持不能改他的代码.

既然从IE方向无法下手,就只能改变方向,从Windows窗口方向下手.因为弹出窗口也是窗口,可以进行捕获弹出窗口句柄,然后遍历出Webbrowser控制句柄,再转换成Document对象.得到Document对象就可以对网页进行随意控制了.

关键代码如下:

'BHO类中下勾子

hWndRetProcHook = SetWindowsHookEx(HookType.WH_CALLWNDPROCRET,AddressOf modCallback.CallWndRetProc,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,lParam)

Exit Function

ErrorLine:

MsgBox "发生异常." & Err.Description,vbCritical

CallWndRetProc = CallNextHookEx(hWndRetProcHook,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,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,hwnd

'End If

If IsIEServerWindow(hwnd) Then

'注册消息

lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")

'发送消息

SendMessageTimeout hwnd,lMsg,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,IEDOMFromhWnd)

'MsgBox "HR:" & hr

End If

End If

End If

End Function这里利用Active Accessibility组件获取的Document对象.

通过上面的代码就完成了对IE弹出模块窗口的控制.其中WIN7和XP下调用API的一些差别让我走了不少弯路,现在还不明白这些差异是如何产生的,希望了解真相的人士指点一二.

总结

以上是编程之家为你收集整理的VB6 控制IE弹出模式窗口全部内容，希望文章能够帮你解决VB6 控制IE弹出模式窗口所遇到的程序开发问题。

如果觉得编程之家网站内容还不错，欢迎将编程之家网站推荐给程序员好友。

本图文内容来源于网友网络收集整理提供，作为学习参考使用，版权属于原作者。

小编个人微信号 jb51ccc

喜欢与人分享编程技术与工作经验，欢迎加入编程之家官方交流群！