【抄襲】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 屬性來禁止該行爲。