【抄袭】VB.NET扩展WebBrowser，拥有跳转前获取URL的能力

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

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

 

Imports System.ComponentModel

Imports System.Runtime.InteropServices



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

Public Class WebBrowserExt

    Inherits WebBrowser



    Shadows cookie As AxHost.ConnectionPointCookie

    Shadows events As WebBrowserExtEvents



    Protected Overrides Sub CreateSink()

        MyBase.CreateSink()

        events = New WebBrowserExtEvents(Me)

        cookie = New AxHost.ConnectionPointCookie(Me.ActiveXInstance, events, GetType(DWebBrowserEvents2))

    End Sub



    Protected Overrides Sub DetachSink()

        If Not cookie Is Nothing Then

            cookie.Disconnect()

            cookie = Nothing

        End If

        MyBase.DetachSink()

    End Sub



    ''' <summary>在跳转前</summary>

    Public Event BeforeNavigate(sender As Object, e As NavEventArgsExt)

    ''' <summary>在弹出新窗体前</summary>

    Public Event BeforeNewWindow(sender As Object, e As NavEventArgsExt)



    Protected Sub OnBeforeNewWindow(url As String, ByRef cancel As Boolean)

        Dim args As New NavEventArgsExt(url, Nothing)

        RaiseEvent BeforeNewWindow(Me, args)

        cancel = args.Cancel

    End Sub



    Protected Sub OnBeforeNavigate(url As String, frame As String, ByRef cancel As Boolean)

        Dim args As New NavEventArgsExt(url, frame)

        RaiseEvent BeforeNavigate(Me, args)

        cancel = args.Cancel

    End Sub







    ''' <summary>跳转事件封包</summary>

    Public Class NavEventArgsExt

        Inherits CancelEventArgs



        Sub New(url As String, frame As String)

            MyBase.New()

            _Url = url

            _Frame = frame

        End Sub



        Private _Url As String

        ReadOnly Property Url As String

            Get

                Return _Url

            End Get

        End Property



        Private _Frame As String

        ReadOnly Property Frame As String

            Get

                Return _Frame

            End Get

        End Property

    End Class





    Private Class WebBrowserExtEvents

        Inherits StandardOleMarshalObject

        Implements DWebBrowserEvents2



        Dim _browser As WebBrowserExt

        Sub New(browser As WebBrowser)

            _browser = browser

        End Sub



        Public Sub BeforeNavigate2(pDisp As Object, ByRef url As Object, ByRef flags As Object, ByRef targetFrameName As Object, ByRef postData As Object, ByRef headers As Object, ByRef cancel As Boolean) Implements DWebBrowserEvents2.BeforeNavigate2

            _browser.OnBeforeNavigate(CType(url, String), CType(targetFrameName, String), cancel)

        End Sub



        Public Sub NewWindow3(pDisp As Object, ByRef cancel As Boolean, ByRef flags As Object, ByRef URLContext As Object, ByRef URL As Object) Implements DWebBrowserEvents2.NewWindow3

            _browser.OnBeforeNewWindow(CType(URL, String), cancel)

        End Sub

    End Class



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

    InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIDispatch), _

    TypeLibType(TypeLibTypeFlags.FHidden)> _

    Public Interface DWebBrowserEvents2



        <DispId(250)> _

        Sub BeforeNavigate2(<[In](), MarshalAs(UnmanagedType.IDispatch)> pDisp As Object, <[In]()> ByRef url As Object, <[In]()> ByRef flags As Object, <[In]()> ByRef targetFrameName As Object, <[In]()> ByRef postData As Object, <[In]()> ByRef headers As Object, <[In](), Out()> ByRef cancel As Boolean)



        <DispId(273)> _

        Sub NewWindow3(<[In](), MarshalAs(UnmanagedType.IDispatch)> pDisp As Object, <[In](), Out()> ByRef cancel As Boolean, <[In]()> ByRef flags As Object, <[In]()> ByRef URLContext As Object, <[In]()> ByRef URL As Object)



    End Interface



End Class

 

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

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