关天WebBrowser右键问题。。

[kgdlnyq]

我用 WebBrowser.Navigate "c:\test.doc" 找工WORD文档，请问怎样屏蔽右键功能呢？
看过以前的贴子说可以用鼠标钩子，但是不太懂，麻烦哪位帮我解释一下。

[蒋晟]

Unfortunately, when WebBrowser control displays data that other than MSHTML (such as PDF, Word or Excel data) then DHTML DOM is not available, and IDocHostUIHandler::ShowContextMenu is not called. There is no official method to suppress context menus in these cases.

[rainstormmaster]

Option Explicit
Private Declare Sub ZeroMemory Lib "KERNEL32" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes As Long)
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Const PM_NOREMOVE = &H0
Private Const PM_NOYIELD = &H2
Private Const PM_REMOVE = &H1
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type Msg
hwnd As Long
Message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Declare Function TranslateMessage Lib "user32" (lpMsg As Msg) As Long
Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As Msg) As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Private bCancel As Boolean
Private webHwnd As Long '窗体中webbrowser控件的句柄
Private Sub ProcessMessages()
Dim Message As Msg
'loop until bCancel is set to True
Do While Not bCancel
'等待一个消息
WaitMessage
'检查webbrowser控件及其子窗口的所有消息
If PeekMessage(Message, webHwnd, 0, 0, PM_REMOVE) Then
Select Case Message.Message
'过滤掉关于右键操作的三个消息WM_RBUTTONDOWN 、WM_RBUTTONUP、WM_RBUTTONDBLCLK
Case WM_RBUTTONDOWN
MsgBox "Webbrowser控件的WM_RBUTTONDOWN消息已经被屏蔽"
Case WM_RBUTTONUP
MsgBox "Webbrowser控件的WM_RBUTTONUP消息已经被屏蔽"
Case WM_RBUTTONDBLCLK
MsgBox "Webbrowser控件的WM_RBUTTONDBLCLK消息已经被屏蔽"
'对于其它消息则放行
Case Else
TranslateMessage Message
DispatchMessage Message
End Select
End If
'将控制权交还给系统，否则将陷入死循环
DoEvents
Loop
End Sub

Private Sub Command1_Click()
Me.WebBrowser1.Navigate "www.csdn.net"
End Sub

Private Sub Form_Load()
Dim Ret As Long
bCancel = False
Show
webHwnd = FindWindowEx(Me.hwnd, 0, "Shell Embedding", vbNullString)
If webHwnd > 0 Then
ProcessMessages
End If
End Sub


Private Sub Form_Unload(Cancel As Integer)
bCancel = True
End Sub

需要指出的是,上面的程序理论上可以很好的拦截右键消息,但是由于程序中Do While循环占用了大量系统资源,有时候就会导致进程阻塞,偶尔会有漏网之鱼

[韧恒]

对于这个问题不需使用子类，引用Microsoft HTML OBject Library可以解决，并且可以解决很多问题。

Dim WithEvents M_Dom As MSHTML.HTMLDocument
Private Function M_Dom_oncontextmenu() As Boolean
M_Dom_oncontextmenu = False
End Function

Private Sub Webbrowser1_DownloadComplete()
Set M_Dom = Webbrowser1.Document
End Sub

[kgdlnyq]

谢谢songyaowu你的回答，但是你这个方法工试过了，只能当打开的是网页时才行，但是我现在打开WORD文档时就没用了！

[kgdlnyq]

UP一下

[kgdlnyq]

to:rainstormmaster(暴风雨 v2.0)
谢谢你的回答，上面哪段代码我试过，如果是Navigate一个网页是可以的，但是我现在Navigate一个WORD文档就不生效的！
我调试过是因为加载一个WORD文档后，PeekMessage(Message, webHwnd, 0, 0, PM_REMOVE)就永远返回假值了！

[hpygzhx520]

枚举，得到Internet Explorer_Server类，再检测消息。因为类名变化为Internet Explorer_Server了。

[hpygzhx520]

关键在于Shell Embedding
访问一个地址（文件）后，就不是这个类名了，并且FindWindowEx似乎无法获得。

[rainstormmaster]

//关键在于Shell Embedding
访问一个地址（文件）后，就不是这个类名了，并且FindWindowEx似乎无法获得。

不是这样的，webbrowser控件的类名没变，还是Shell Embedding，只是多了几层子窗口


//我调试过是因为加载一个WORD文档后，PeekMessage(Message, webHwnd, 0, 0, PM_REMOVE)就永远返回假值了！

这个原因是，word组件使用的是进程外组件模型，而PeekMessage只能拦截本线程的消息，所以导致失败。解决办法是用全局消息钩子hook。或者看看word组件是否提供了相应的支持

[IamDeane]

看看这上面的第一个代码是不是你需要的
http://blog.tom.com/blog/blogindex.php?username=iamdeane