屏蔽webbrowser控制項右鍵的一種方法

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 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

 遺憾的是,程式有時候會發生進程阻塞，導致攔截訊息失敗