VB.NET扩展WebBrowser，拥有跳转前获取URL的能力 ,扩展事件

来自http://www.cnblogs.com/yuanjw/archive/2009/02/09/1386789.html

我仅做VB化，并优化了事件消息

Imports System.ComponentModel
 System.Runtime.InteropServices

''' <summary>扩展WebBrowser，拥有跳转前获取URL的能力</summary>
Public Class WebBrowserExt
    Inherits WebBrowser

    Shadows cookie As AxHost.ConnectionPointCookie
    Shadows events  WebBrowserExtEvents

    Protected Overrides Sub CreateSink()
        MyBase.CreateSink()
        events = New WebBrowserExtEvents(Me)
        cookie = New AxHost.ConnectionPointCookie(Me.ActiveXInstance,events,GetType(DWebBrowserEvents2))
    End Sub

     DetachSink()
        If Not cookie Is Nothing Then
            cookie.Disconnect()
            cookie = Nothing
        End If
        .DetachSink()
    End Sub

    在跳转前</summary>
    Event BeforeNavigate(sender As Object,e  NavEventArgsExt)
    在弹出新窗体前Event BeforeNewWindow(sender  NavEventArgsExt)

 ''' <summary>在浏览发生错误时</summary>
 Public Event NavigateError(sender As Object,e As NavEventArgsExt)

    Sub OnBeforeNewWindow(url String,255)">ByRef cancel Boolean)
        Dim args New NavEventArgsExt(url,255)">NothingRaiseEvent BeforeNewWindow(,args)
        cancel = args.Cancel
    Sub OnBeforeNavigate(url New NavEventArgsExt(url,frame)
        RaiseEvent BeforeNavigate(End Sub

  Protected Overridable Sub OnNavigateError(url As String,frame As String,statusCode As Int32,ByRef cancel As Boolean)  Debug.Print("OnNavigateError")  Dim args As New NavEventArgsExt(url,frame)  RaiseEvent NavigateError(Me,args)  cancel = args.Cancel  End Sub



    跳转事件封包 NavEventArgsExt
         CancelEventArgs

        Sub New(url String)
            .New()
            _Url = url
            _Frame = frame
        End Sub

        Private _Url String
        ReadOnly Property Url String
            Get
                Return _Url
            Get
        End Property

        Private _Frame Property Frame  _Frame
            End Property
    End Class


    Private  WebBrowserExtEvents
         StandardOleMarshalObject
        Implements DWebBrowserEvents2

        Dim _browser  WebBrowserExt
        New(browser  WebBrowser)
            _browser = browser
        Sub BeforeNavigate2(pDisp ByRef url ByRef flags ByRef targetFrameName ByRef postData ByRef headers Boolean)  DWebBrowserEvents2.BeforeNavigate2
            _browser.OnBeforeNavigate(CType(url,255)">String),255)">CType(targetFrameName,0)">),cancel)
        Sub NewWindow3(pDisp Boolean,255)">ByRef URLContext ByRef URL Object)  DWebBrowserEvents2.NewWindow3
            _browser.OnBeforeNewWindow(CType(URL,255)">  Public Sub NavigateError(pDisp As Object,ByRef URL As Object,ByRef frame As Object,ByRef statusCode As Object,ByRef cancel As Boolean) Implements DWebBrowserEvents2.NavigateError  _browser.OnNavigateError(CType(URL,String),CType(frame,CType(statusCode,Int32),cancel)  End Sub
    End Class

    <ComImport(),Guid("34A715A0-6587-11D0-924A-0020AFC7AC4D" _
    Interface DWebBrowserEvents2

        <DispId(250)> _
        Sub BeforeNavigate2(<[In](),MarshalAs(UnmanagedType.IDispatch)> pDisp In]()> )

        <DispId(273)>Sub NewWindow3(<[Object)

<DispId(271)>
 Sub NavigateError( _
 <InAttribute(),MarshalAs(UnmanagedType.IDispatch)> _
 ByVal pDisp As Object,_
 <InAttribute()> ByRef URL As Object,_
 <InAttribute()> ByRef frame As Object,_
 <InAttribute()> ByRef statusCode As Object,_
 <InAttribute(),OutAttribute()> ByRef cancel As Boolean)
    End Interface

End Class

新添加的两个事件，通过 e.Url 可以直接截获跳转的URL，通过 e.Cancel 可以禁止浏览器进行跳转。

但是默认WebBrowser可以接受IE的默认菜单和快捷键，可以通过IsWebBrowserContextMenuEnabled 和WebBrowserShortcutsEnabled 属性来禁止该行为。