VB：屏蔽IE的右键菜单

         关于BHO的文章现在已经很多了，对BHO就不做介绍了。

        原理是利用在BHO中维护一个IWebbrowser2接口，然后通过这个接口获得一个IHTMLDocument2接口，然后通过这个接口获得ICustomDoc 接口，然后通过ICustomDoc 接口的SetUIHandle方法将自己的IDocHostUIHandler实现连接到IE上面

  下面说说要点：

   1    BHO只要实现IObjectWithSite接口即可，而获得IWebbrowser2接口的时机毫无疑问应该是在IObjectWithSite_SetSite中

  2   获得IHTMLDocument2接口的时机我选择了IWebbrowser2的DocumentComplete事件，这也是通常的做法，但不是最明智的方法，明智的做法应该是由IConnectionPoint接口去通知IWebbrowser2它对某个事件比较感兴趣

  3  由于只是屏蔽右键菜单，所以只处理了IDocHostUIHandler_ShowContextMenu，对于其它不需处理的地方尽管理论上只需返回HRESULT即可，但遗憾的是VB没法直接返回HRESULT，于是通过Err.Raise E_NOTIMPL处理了一下。但更加遗憾的是，如果不对声明进行处理，它会更不给你面子，你不知道何时你的程序会崩溃。更加更加遗憾的是由于放火墙频繁重起，导致我现在心情不好，实在不愿意干这个费力气的活，所以留到以后再说吧

好了，不废话了，下面给出代码：

'首先引用：Edanmo's OLE interfaces for Implements v1.51，Edanmo's OLE interfaces & functions v1.81， Microsoft Internet Controls，VB Shell Library

Option Explicit
'马畅（rainstormmaster)的游戏之作，虽然有很多问题，但转载请保留上述信息

'接口
Implements VBShellLib.IObjectWithSite
Implements olelib.IDocHostUIHandler

'声明
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

' private variables
Private moUnknown As IUnknownVB
Private WithEvents moBrowser As InternetExplorer
Private mDOC As olelib.ICustomDoc
Private mShow As Boolean
'这个不处理也行
Private Sub IObjectWithSite_GetSite(ByVal priid As VBShellLib.REFIID, ppvObj As VBShellLib.VOID)

   ' 返回我们已经得到的接口
   If Not (moUnknown Is Nothing) Then
      moUnknown.QueryInterface priid, ppvObj
   End If

End Sub

' 这个必须处理，获得IE的IWebbrowser2接口
Private Sub IObjectWithSite_SetSite(ByVal pSite As VBShellLib.IUnknownVB)

   Set moUnknown = pSite
   '用不着了，就释放掉
   If ObjPtr(pSite) = 0 Then
      CopyMemory moBrowser, 0&, 4
   Else
      '获得IE的IWebbrowser2接口
      Set moBrowser = moUnknown
   End If

End Sub

'通过ICustomDoc接口挂接IDocHostUIHandler接口
Private Sub moBrowser_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    '获得ICustomDoc接口
    Set mDOC = moBrowser.document
    '挂接IDocHostUIHandler接口
    mDOC.SetUIHandler Me
End Sub
'以下基本都没做处理，由于VB没法直接返回HRESULT，所以用Err.Raise E_NOTIMPL处理了
'一下，需要注意的是：这里有隐患（可以通过自己修改ODL解决，不过这是个费力气
'的活，以后心情好再说吧），在IDE中调试可能会引起崩溃
Private Sub IDocHostUIHandler_EnableModeless(ByVal fEnable As olelib.BOOL)
    Err.Raise E_NOTIMPL
End Sub

Private Function IDocHostUIHandler_FilterDataObject(ByVal pDO As olelib.IDataObject) As olelib.IDataObject
    Err.Raise E_NOTIMPL
End Function

Private Function IDocHostUIHandler_GetDropTarget(ByVal pDropTarget As olelib.IDropTarget) As olelib.IDropTarget
    Err.Raise E_NOTIMPL
End Function

Private Function IDocHostUIHandler_GetExternal() As Object
    Err.Raise E_NOTIMPL
End Function

Private Sub IDocHostUIHandler_GetHostInfo(pInfo As olelib.DOCHOSTUIINFO)
    Err.Raise E_NOTIMPL
End Sub

Private Sub IDocHostUIHandler_GetOptionKeyPath(pOLESTRchKey As Long, ByVal dw As Long)
    Err.Raise E_NOTIMPL
End Sub

Private Sub IDocHostUIHandler_HideUI()
    Err.Raise E_NOTIMPL
End Sub

Private Sub IDocHostUIHandler_OnDocWindowActivate(ByVal fActivate As olelib.BOOL)
     Err.Raise E_NOTIMPL
End Sub

Private Sub IDocHostUIHandler_OnFrameWindowActivate(ByVal fActivate As olelib.BOOL)
    Err.Raise E_NOTIMPL
End Sub

Private Sub IDocHostUIHandler_ResizeBorder(prcBorder As olelib.RECT, ByVal pUIWindow As olelib.IOleInPlaceUIWindow, ByVal fRameWindow As olelib.BOOL)
    Err.Raise E_NOTIMPL
End Sub
'唯一做出处理的地方，屏蔽IE的右键菜单
Private Sub IDocHostUIHandler_ShowContextMenu(ByVal dwContext As olelib.ContextMenuTarget, pPOINT As olelib.POINT, ByVal pCommandTarget As olelib.IOleCommandTarget, ByVal HTMLTagElement As Object)
    If mShow = True Then
        IDocHostUIHandler.ShowContextMenu dwContext, pPOINT, pCommandTarget, HTMLTagElement
    End If
End Sub

Private Sub IDocHostUIHandler_ShowUI(ByVal dwID As Long, ByVal pActiveObject As olelib.IOleInPlaceActiveObject, ByVal pCommandTarget As olelib.IOleCommandTarget, ByVal pFrame As olelib.IOleInPlaceFrame, ByVal pDoc As olelib.IOleInPlaceUIWindow)
    Err.Raise E_NOTIMPL
End Sub

Private Sub IDocHostUIHandler_TranslateAccelerator(lpmsg As olelib.MSG, pguidCmdGroup As olelib.UUID, ByVal nCmdID As Long)
    Err.Raise E_NOTIMPL
End Sub

Private Function IDocHostUIHandler_TranslateUrl(ByVal dwTranslate As Long, ByVal pchURLIn As Long) As Long
    Err.Raise E_NOTIMPL
End Function

Private Sub IDocHostUIHandler_UpdateUI()
    Err.Raise E_NOTIMPL
End Sub

编译后用regsvr32注册dll，然后用oleview看看它的GUID，然后打开记事本写入如下内容：

REGEDIT4

#
# browser helper object - register the DLL first
# template GUID: D5B72AED-E54A-11D6-B1B2-444553540000
#

[HKEY_LOCAL_MACHINE/Software/Microsoft/Windows/CurrentVersion/Explorer/Browser Helper Objects]
[HKEY_LOCAL_MACHINE/Software/Microsoft/Windows/CurrentVersion/Explorer/Browser Helper Objects/{D5B72AED-E54A-11D6-B1B2-444553540000}]
注意，要把上面的D5B72AED-E54A-11D6-B1B2-444553540000换成你的GUID

然后，保存为reg文件，最后将reg文件导入注册表

注销的话，reg文件对应内容为：

REGEDIT4

#
# browser helper object - register the DLL first
# template GUID: D5B72AED-E54A-11D6-B1B2-444553540000
#

[-HKEY_LOCAL_MACHINE/Software/Microsoft/Windows/CurrentVersion/Explorer/Browser Helper Objects/{D5B72AED-E54A-11D6-B1B2-444553540000}]

同样，注意用你的GUID去换掉原来的D5B72AED-E54A-11D6-B1B2-444553540000