Subclass the Microsoft Web Browser control

Category:

Forms and Controls

Type:

Modules

Difficulty:

Advanced

Author:

Anonymous

Version Compatibility: Visual Basic 6, Visual Basic 5

More information:

Subclassing the Microsoft Web Browser control is not as easy as it might seem at first. There are two problems that must be overcome.

First, Microsoft doesn't want you to do this at all, so they make the hWnd property of the control unreadable. In order to get the hWnd of the web browser control, you have to take the webBrowser.Parent.hWnd value and call EnumChildWindows. Once you find the right window by class name, you can get the hWnd of the control itself.

The second problem is that the window you need to subclass does not exist until you have loaded a web page into the control. To get around this issue, you need to place the following line of code into the following event:

Private Sub webBrowser_BeforeNavigate2()
    'Only hook the window procedure once
    If Not HookedWebBrowser Then Call HookWebBrowser(Me.webBrowser.Parent.hwnd)
End Sub

Now you can trap the window messages sent to the web browser control just like you would for a form or other control. My example here disables the right-mouse button so that users can't get the pop-up menu in my application.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _ ByVal hwnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" ( _ ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare Function EnumChildWindows Lib "user32" ( _ ByVal hWndParent As Long, _ ByVal lpEnumFunc As Long, _ ByVal lParam As Long) As Long Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _ ByVal lpPrevWndFunc As Long, _ ByVal hwnd As Long, _ ByVal Msg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long 'API parameter constants Private Const GWL_WNDPROC As Long = -4& Private Const GW_CHILD As Long = 5& Private Const API_FAILED As Long = 0& Private Const API_NULL As Long = 0& Private Const API_TRUE As Long = 1& Private Const API_FALSE As Long = 0& 'Class name we want to subclass Private Const IE_WB_CONTROL_CLASS_NAME As String = "Internet Explorer_Server" 'Window Procedure Message Constants Private Const WM_RBUTTONDOWN As Long = &H204& Private Const WM_RBUTTONUP As Long = &H205& 'Local pointer variables Private lngOriginalWindowProc As Long Private lngWebControlHWND As Long

Code:

Public Sub HookWebBrowser(ByVal WebControlContainerHWND As Long)
    'Define local variables
    Dim lngReturnValue As Long
    'Loop through the child windows for the Web Control's parent
    lngReturnValue = EnumChildWindows(WebControlContainerHWND, AddressOf EnumChildWindowsCallback, API_NULL)
    If Not (lngReturnValue = API_FAILED) And lngWebControlHWND <> 0 Then
        'Subclass the Web Control Window with the new-found hWnd
        lngOriginalWindowProc = SetWindowLong(lngWebControlHWND, GWL_WNDPROC, AddressOf WebBrowserWindowProc)
    End If
End Sub

Public Function HookedWebBrowser() As Boolean
    'Give a way to tell if we are currently subclassed
    HookedWebBrowser = CBool(lngOriginalWindowProc)
End Function

Public Sub UnHookWebBrowser()
    'Define local variables
    Dim lngReturnValue As Long
    'Reset the window procedure to the original value
    lngReturnValue = SetWindowLong(lngWebControlHWND, GWL_WNDPROC, lngOriginalWindowProc)
    'Reset the local window procedure address
    lngOriginalWindowProc = 0
End Sub

Private Function EnumChildWindowsCallback(ByVal hwnd As Long, ByVal lParam As Long) As Long
    'Define local variables
    Dim lngReturnValue As Long
    Dim strClassString As String * 256
    'Get the classname for this handle
    lngReturnValue = GetClassName(hwnd, strClassString, 256)
    'If we got a class name...
    If Not (lngReturnValue = API_FAILED) Then
        'See if the classname matches
        If (Left$(strClassString, InStr(strClassString, Chr$(0)) - 1) = IE_WB_CONTROL_CLASS_NAME) Then _
            lngWebControlHWND = hwnd
    End If
    'You could avoid extra looping by ending the
    'enumeration once you find the proper window
    'but then the function "EnumChildWindows" returns
    'FALSE as if there was an error, and we don't want
    'that to happen.
    EnumChildWindowsCallback = API_TRUE
End Function

Private Function WebBrowserWindowProc(ByVal WindowHandle As Long, _
                                      ByVal Message As Long, _
                                      ByVal wParam As Long, _
                                      ByVal lParam As Long) As Long
    Select Case Message
        Case WM_RBUTTONUP, WM_RBUTTONDOWN
            'Don't let it see the right mouse button up or down
            WebBrowserWindowProc = 0
        Case Else
            'Pass anything else through unchanged
            WebBrowserWindowProc = CallWindowProc(lngOriginalWindowProc, WindowHandle, Message, wParam, lParam)
    End Select
End Function