不使用BHO监控IE窗口事件

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

'* ************************************** * '* 类名称：IEHooker '* 类功能：监控IE窗口打开和关闭事件 '* 作者：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窗口关闭事件 '- ----------------------------------- Private Sub m_shWindows_WindowRevoked(ByVal lCookie As Long) Dim i As Long Dim blnFound As Boolean '从数组中移出将要关闭的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事件，需要添加一个事件类，代码如下：

'* ************************************** * '* 类名称：IEEvent '* 类功能：IE事件类 '* 作者：lyserver '* 备注：需要引用Microsoft Internet Controls '* 和Microsoft HTML Object Library类库 '* ************************************** * Option Explicit Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (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 '- ----------------------------------- ' 函数说明：IE文档右键菜单事件 '- ----------------------------------- Private Function m_objDoc_oncontextmenu() As Boolean MessageBox m_objIE.hwnd, "IE的右键菜单被拦截了", "测试", 0 m_objDoc_oncontextmenu = True '继续显示右键菜单 End Function '- ----------------------------------- ' 过程说明：IE文档加载完成事件 '- ----------------------------------- Private Sub m_objIE_DocumentComplete(ByVal pDisp As Object, URL As Variant) Set m_objDoc = m_objIE.Document End Sub '- ----------------------------------- ' 过程说明：IE窗口关闭事件 '- ----------------------------------- Private Sub m_objIE_OnQuit() Set m_objIE = Nothing End Sub

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

'* ************************************** * '* 类名称：IEHooker '* 类功能：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窗口关闭事件 '- ----------------------------------- Private Sub m_shWindows_WindowRevoked(ByVal lCookie As Long) Dim i As Long Dim blnFound As Boolean '从数组中移出将要关闭的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文档区按右键，均会先弹出一个对话框，然后才出现菜单。