有时候我们想在应用程序中拦截某个IE窗口的事件，大多数情况下我们会想到BHO，但BHO安装不方便，而且容易被杀毒软件当作木马给清理掉。其实，在VB里还有更好的办法，就是使用ShellWindows对象。下面，我基于ShellWindows对象写了一个简单的IE窗口事件监控类，代码如下：

'* ************************************** * '* 类<a href="/tag/mingcheng/" target="_blank" class="keywords">名称</a>：IEHooker '* 类<a href="/tag/gongneng/" target="_blank" class="keywords">功能</a>：监控IE窗口打开和<a href="/tag/guanbi/" target="_blank" class="keywords">关闭</a>事件 '* 作者：lyserver '* 备注：需要引用Microsoft Internet Controls类库 '* ************************************** * Option Explicit Dim WithEvents m_shWindows As ShellWindows Dim m_objIE() As InternetExplorer Dim m_nIeCount As Long '- ----------------------------------- ' 过程说明：类初始化 '- ----------------------------------- Private Sub Class_Initialize() Dim objIE As InternetExplorer '加入已打开的IE对象到数组中 Set m_shWindows = New ShellWindows For Each objIE In m_shWindows If InStr(objIE.FullName,"/iexplore.exe") Then ReDim Preserve m_objIE(m_nIeCount) Set m_objIE(m_nIeCount) = objIE m_nIeCount = m_nIeCount + 1 End If Next End Sub '- ----------------------------------- ' 过程说明：类销毁 '- ----------------------------------- Private Sub Class_Terminate() Dim i As Long '销毁数组 For i = 0 To m_nIeCount - 1 Set m_objIE(i) = Nothing Next Erase m_objIE End Sub '- ----------------------------------- ' 过程说明：IE窗口打开事件 '- ----------------------------------- Private Sub m_shWindows_WindowRegistered(ByVal lCookie As Long) '加入将要打开的IE对象到数组中 If InStr(m_shWindows.Item.FullName,"/iexplore.exe") = 0 Then Exit Sub ReDim Preserve m_objIE(m_nIeCount) Set m_objIE(m_nIeCount) = m_shWindows.Item m_nIeCount = m_nIeCount + 1 End Sub '- ----------------------------------- ' 过程说明：IE窗口<a href="/tag/guanbi/" target="_blank" class="keywords">关闭</a>事件 '- ----------------------------------- Private Sub m_shWindows_WindowRevoked(ByVal lCookie As Long) Dim i As Long Dim blnFound As Boolean '从数组中移出将要<a href="/tag/guanbi/" target="_blank" class="keywords">关闭</a>的IE对象 If InStr(m_shWindows.Item.FullName,"/iexplore.exe") = 0 Then Exit Sub For i = 0 To m_nIeCount - 1 If m_objIE(i).hWnd = m_shWindows.Item.hWnd Then blnFound = True If blnFound Then If i = m_nIeCount - 1 Then Exit For Set m_objIE(i) = m_objIE(i + 1) End If Next m_nIeCount = m_nIeCount - 1 If m_nIeCount > 0 Then ReDim Preserve m_objIE(m_nIeCount - 1) End Sub

测试代码如下：

Dim objIeHooker As IeHooker Private Sub Form_Load() Set objIeHooker = New IeHooker End Sub Private Sub Form_Unload(Cancel As Integer) Set objIeHooker = Nothing End Sub

该类只是一个示例，没有实现更多事件的监控，大家可以在这个类的基础上，基于DOM添加自己需要监控的事件，比如拦截右键菜单。为了拦截DOM事件，需要添加一个事件类，代码如下：

'* ************************************** * '* 类<a href="/tag/mingcheng/" target="_blank" class="keywords">名称</a>：IEEvent '* 类<a href="/tag/gongneng/" target="_blank" class="keywords">功能</a>：IE事件类 '* 作者：lyserver '* 备注：需要引用Microsoft Internet Controls '* 和Microsoft HTML Object Library类库 '* ************************************** * Option Explicit Private Declare Function Message<a href="/tag/Box/" target="_blank" class="keywords">Box</a> Lib "user32" Alias "Message<a href="/tag/Box/" target="_blank" class="keywords">Box</a>A" (ByVal hwnd As Long,ByVal lpText As String,ByVal lpCaption As String,ByVal wType As Long) As Long Public WithEvents m_objIE As InternetExplorer Public WithEvents m_objDoc As HTMLDocument '- ----------------------------------- ' 过程说明：类初始化 '- ----------------------------------- Private Sub Class_Initialize() ' End Sub '- ----------------------------------- ' 过程说明：类销毁 '- ----------------------------------- Private Sub Class_Terminate() Set m_objDoc = Nothing Set m_objIE = Nothing End Sub '- ----------------------------------- ' <a href="/tag/hanshu/" target="_blank" class="keywords">函数</a>说明：IE文档右键<a href="/tag/caidan/" target="_blank" class="keywords">菜单</a>事件 '- ----------------------------------- Private Function m_objDoc_oncontextmenu() As Boolean Message<a href="/tag/Box/" target="_blank" class="keywords">Box</a> m_objIE.hwnd,"IE的右键<a href="/tag/caidan/" target="_blank" class="keywords">菜单</a>被<a href="/tag/lanjie/" target="_blank" class="keywords">拦截</a>了","测试",0 m_objDoc_oncontextmenu = True '继续<a href="/tag/xianshi/" target="_blank" class="keywords">显示</a>右键<a href="/tag/caidan/" target="_blank" class="keywords">菜单</a> End Function '- ----------------------------------- ' 过程说明：IE文档加载完成事件 '- ----------------------------------- Private Sub m_objIE_DocumentComplete(ByVal pDisp As Object,URL As Variant) Set m_objDoc = m_objIE.Document End Sub '- ----------------------------------- ' 过程说明：IE窗口<a href="/tag/guanbi/" target="_blank" class="keywords">关闭</a>事件 '- ----------------------------------- Private Sub m_objIE_OnQuit() Set m_objIE = Nothing End Sub

事件监控类代码修改如下：

'* ************************************** * '* 类<a href="/tag/mingcheng/" target="_blank" class="keywords">名称</a>：IEHooker '* 类<a href="/tag/gongneng/" target="_blank" class="keywords">功能</a>：IE事件监控类 '* 作者：lyserver '* 备注：需要引用Microsoft Internet Controls类库 '* ************************************** * Option Explicit Dim WithEvents m_shWindows As ShellWindows Dim m_ieEvent() As IEEvent Dim m_nIeCount As Long '- ----------------------------------- ' 过程说明：类初始化 '- ----------------------------------- Private Sub Class_Initialize() Dim objIE As InternetExplorer '加入已打开的IE对象到数组中 Set m_shWindows = New ShellWindows For Each objIE In m_shWindows If InStr(objIE.FullName,"/iexplore.exe") Then ReDim Preserve m_ieEvent(m_nIeCount) Set m_ieEvent(m_nIeCount) = New IEEvent Set m_ieEvent(m_nIeCount).m_objIE = objIE Set m_ieEvent(m_nIeCount).m_objDoc = objIE.Document m_nIeCount = m_nIeCount + 1 End If Next End Sub '- ----------------------------------- ' 过程说明：类销毁 '- ----------------------------------- Private Sub Class_Terminate() Dim i As Long '销毁数组 For i = 0 To m_nIeCount - 1 Set m_ieEvent(i) = Nothing Next Erase m_ieEvent End Sub '- ----------------------------------- ' 过程说明：IE窗口打开事件 '- ----------------------------------- Private Sub m_shWindows_WindowRegistered(ByVal lCookie As Long) Dim objIE As InternetExplorer '加入将要打开的IE对象到数组中 Set objIE = m_shWindows(m_shWindows.Count - 1) If InStr(objIE.FullName,"/iexplore.exe") = 0 Then Exit Sub ReDim Preserve m_ieEvent(m_nIeCount) Set m_ieEvent(m_nIeCount) = New IEEvent Set m_ieEvent(m_nIeCount).m_objIE = objIE m_nIeCount = m_nIeCount + 1 End Sub '- ----------------------------------- ' 过程说明：IE窗口<a href="/tag/guanbi/" target="_blank" class="keywords">关闭</a>事件 '- ----------------------------------- Private Sub m_shWindows_WindowRevoked(ByVal lCookie As Long) Dim i As Long Dim blnFound As Boolean '从数组中移出将要<a href="/tag/guanbi/" target="_blank" class="keywords">关闭</a>的IE对象 For i = 0 To m_nIeCount - 1 If m_ieEvent(i).m_objIE Is Nothing Then blnFound = True If blnFound Then If i = m_nIeCount - 1 Then Exit For Set m_ieEvent(i) = m_ieEvent(i + 1) End If Next m_nIeCount = m_nIeCount - 1 If m_nIeCount > 0 Then ReDim Preserve m_ieEvent(m_nIeCount - 1) End Sub

测试代码不变。

当工程运行后，无论在哪一个IE窗口的HTML文档区按右键，均会先弹出一个对话框，然后才出现菜单。