VB.net webbrowser 如何实现自定义下载 IDownloadManager

写这篇文章之前，首先十分多谢
蒋晟 ，其次也谢谢ysjyniiq ，在csdn里私信问了N多人如何实现IDownloadManager接口，只有ysjyniiq 热心回答，其他人都十分忙^_^。

因为要写些实现自动控制的小程序，里面要实现下载相关文件，之前通过扫描下载窗口并发送消息实现，既不高效，也不方便，便想着如何实现自定义下载。

哥哥和度娘的搜索结果，多数是c语言而且已经都是比较遥远之前的帖子了，讲得也比较简单，一直不得要领，不过我坚信，这么简单的问题，VB一定可以实现的，不能实现只是因为我能力不够而已。

实现自定义下载，办法有：

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

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

这个方法对直接指向下载文件的下载有效，对其他一些间接下载无效；以及在windows8系统下对一些IE默认自动打开的文件下载有效。

这段代码其实微软上有类似的，也是截获DWebBrowserEvents2：http://support.microsoft.com/kb/325204

2、就是实现webbrowser的IDownloadManager，我首先是在这里获得如何实现IDownloadManager的：Extra
WebBrowser Events PART 2 ：http://www.vbib.be/index.php?/tutorials/article/242-extra-webbrowser-events-part-2/

实现接口

Imports System.Runtime.InteropServices  
 Imports System.Runtime.InteropServices.ComTypes  
 Public Class Form1  
     Implements IServiceProvider, IOleClientSite, IAuthenticate, IDownloadManager  
     Public Shared IID_IDownloadManager As New Guid("988934A4-064B-11D3-BB80-00104B35E7F9")  
     Public Shared IID_IAuthenticate As New Guid("79eac9d0-baf9-11ce-8c82-00aa004ba90b")  
     Public Const INET_E_DEFAULT_ACTION As Integer = &H800C0011  
     Public Const S_OK As Integer = 0  
     Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load  
         Me.WebBrowser1.Navigate("about:blank")  
         Dim oc As IOleObject = DirectCast(Me.WebBrowser1.ActiveXInstance, IOleObject)  
         oc.SetClientSite(DirectCast(Me, IOleClientSite))  
     End Sub  
     Public Sub GetContainer(ppContainer As Object) Implements IOleClientSite.GetContainer  
         ppContainer = Me  
     End Sub  
     Public Sub GetMoniker(dwAssign As UInteger, dwWhichMoniker As UInteger, ppmk As Object) Implements IOleClientSite.GetMoniker  
     End Sub  
     Public Sub OnShowWindow(fShow As Boolean) Implements IOleClientSite.OnShowWindow  
     End Sub  
     Public Sub RequestNewObjectLayout() Implements IOleClientSite.RequestNewObjectLayout  
     End Sub  
     Public Sub SaveObject() Implements IOleClientSite.SaveObject  
     End Sub  
     Public Sub ShowObject() Implements IOleClientSite.ShowObject  
     End Sub  
     Public Function QueryService(ByRef guidService As System.Guid, ByRef riid As System.Guid, ByRef ppvObject As System.IntPtr) As Integer Implements IServiceProvider.QueryService  
         If guidService.CompareTo(IID_IAuthenticate) = 0 AndAlso riid.CompareTo(IID_IAuthenticate) = 0 Then  
             ppvObject = Marshal.GetComInterfaceForObject(Me, GetType(IAuthenticate))  
             Return S_OK  
         End If  
         If guidService.CompareTo(IID_IDownloadManager) = 0 AndAlso riid.CompareTo(IID_IDownloadManager) = 0 Then  
             ppvObject = Marshal.GetComInterfaceForObject(Me, GetType(IDownloadManager))  
             Return S_OK  
         End If  
         ppvObject = New IntPtr()  
         Return INET_E_DEFAULT_ACTION  
     End Function  
     Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click  
         'Me.WebBrowser1.Navigate("<a title="Externe link" class="bbc_url" href="http://tradecom.websub.be/bgc_config" rel="nofollow external">http://tradecom.webs....be/bgc_config"</a>)  
         Me.WebBrowser1.Navigate("<a title="Externe link" class="bbc_url" href="http://www.codeproject.com/Articles/229280/VBAExtend" rel="nofollow external">http://www.codeproje...9280/VBAExtend"</a>)  
     End Sub  
     Public Function Authenticate(ByRef phwnd As System.IntPtr, ByRef pszUsername As System.IntPtr, ByRef pszPassword As System.IntPtr) As Integer Implements IAuthenticate.Authenticate  
         phwnd = Me.Handle  
         pszUsername = Marshal.StringToCoTaskMemAuto("username")  
         pszPassword = Marshal.StringToCoTaskMemAuto("password")  
         Return S_OK  
     End Function  
   
     'Public Function Download(pmk As System.IntPtr, pbc As System.IntPtr, dwBindVerb As UInteger, grfBINDF As Integer, pBindInfo As System.IntPtr, pszHeaders As String, pszRedir As String, uiCP As UInteger) As Integer Implements IDownloadManager.Download  
     '   MsgBox(pszRedir)  
     '   Return S_OK  
     'End Function  
     Public Function Download(pmk As IMoniker, pbc As IBindCtx, dwBindVerb As UInteger, grfBINDF As Integer, pBindInfo As System.IntPtr, pszHeaders As String, pszRedir As String, uiCP As UInteger) As Integer Implements IDownloadManager.Download  
         Dim name As String = String.Empty  
         pmk.GetDisplayName(pbc, Nothing, name)  
         MsgBox(name)  
         Return S_OK  
     End Function  
 End Class  
 Class EntryPoint  
     <STAThread()>  
     Shared Sub Main()  
         Application.Run(New Form1())  
     End Sub  
 End Class

定义接口

Imports System.Runtime.InteropServices
<ComImport(), Guid("00000112-0000-0000-C000-000000000046"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _ 
Public Interface IOleObject 
    Sub SetClientSite(ByVal pClientSite As IOleClientSite) 
    Sub GetClientSite(ByVal ppClientSite As IOleClientSite) 
    Sub SetHostNames(ByVal szContainerApp As Object, ByVal szContainerObj As Object) 
    Sub Close(ByVal dwSaveOption As UInteger) 
    Sub SetMoniker(ByVal dwWhichMoniker As UInteger, ByVal pmk As Object) 
    Sub GetMoniker(ByVal dwAssign As UInteger, ByVal dwWhichMoniker As UInteger, ByVal ppmk As Object) 
    Sub InitFromData(ByVal pDataObject As IDataObject, ByVal fCreation As Boolean, ByVal dwReserved As UInteger) 
    Sub GetClipboardData(ByVal dwReserved As UInteger, ByVal ppDataObject As IDataObject) 
    Sub DoVerb(ByVal iVerb As UInteger, ByVal lpmsg As UInteger, ByVal pActiveSite As Object, ByVal lindex As UInteger, ByVal hwndParent As UInteger, ByVal lprcPosRect As UInteger) 
    Sub EnumVerbs(ByVal ppEnumOleVerb As Object) 
    Sub Update() 
    Sub IsUpToDate() 
    Sub GetUserClassID(ByVal pClsid As UInteger) 
    Sub GetUserType(ByVal dwFormOfType As UInteger, ByVal pszUserType As UInteger) 
    Sub SetExtent(ByVal dwDrawAspect As UInteger, ByVal psizel As UInteger) 
    Sub GetExtent(ByVal dwDrawAspect As UInteger, ByVal psizel As UInteger) 
    Sub Advise(ByVal pAdvSink As Object, ByVal pdwConnection As UInteger) 
    Sub Unadvise(ByVal dwConnection As UInteger) 
    Sub EnumAdvise(ByVal ppenumAdvise As Object) 
    Sub GetMiscStatus(ByVal dwAspect As UInteger, ByVal pdwStatus As UInteger) 
    Sub SetColorScheme(ByVal pLogpal As Object) 
End Interface 
<ComImport(), Guid("00000118-0000-0000-C000-000000000046"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _ 
Public Interface IOleClientSite 
    Sub SaveObject() 
    Sub GetMoniker(ByVal dwAssign As UInteger, ByVal dwWhichMoniker As UInteger, ByVal ppmk As Object) 
    Sub GetContainer(ByVal ppContainer As Object) 
    Sub ShowObject() 
    Sub OnShowWindow(ByVal fShow As Boolean) 
    Sub RequestNewObjectLayout() 
End Interface 
<ComImport(), GuidAttribute("79EAC9D0-BAF9-11CE-8C82-00AA004BA90B"), InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown), ComVisible(False)> _ 
Public Interface IAuthenticate 
    <PreserveSig()> _ 
Function Authenticate(ByRef phwnd As IntPtr, ByRef pszUsername As IntPtr, ByRef pszPassword As IntPtr) As <MarshalAs(UnmanagedType.I4)> Integer 
End Interface 
<ComImport(), GuidAttribute("6d5140c1-7436-11ce-8034-00aa006009fa"), InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown), ComVisible(False)> _ 
Public Interface IServiceProvider 
    <PreserveSig()> _ 
    Function QueryService(ByRef guidService As Guid, ByRef riid As Guid, <Out()> ByRef ppvObject As IntPtr) As <MarshalAs(UnmanagedType.I4)> Integer 
End Interface 
<ComImport(), Guid("988934A4-064B-11D3-BB80-00104B35E7F9"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _ 
Public Interface IDownloadManager 
    '.Runtime.InteropServices.ComTypes.IBindCtx,     
    ' System.Runtime.InteropServices.ComTypes.IMoniker,     
    <PreserveSig()> _ 
    Function Download( _ 
             <MarshalAs(UnmanagedType.Interface)> ByVal pmk As ComTypes.IMoniker, _ 
             <MarshalAs(UnmanagedType.Interface)> ByVal pbc As ComTypes.IBindCtx, _ 
             ByVal dwBindVerb As UInteger, _ 
             ByVal grfBINDF As Integer, _ 
             ByVal pBindInfo As IntPtr, _ 
             ByVal pszHeaders As String, _ 
             ByVal pszRedir As String, _ 
             ByVal uiCP As UInteger _ 
            ) As Integer 
End Interface

不过这还不能实现对含跳转链接的下载，例如163的附件下载。

3、通过RegisterBindStatusCallback注册回调事件，获取含跳转链接的下载。

在《微软技术社---新闻组,论坛,BBS》的一个 帖子里，得到蒋晟
的帮助，终于知道RegisterBindStatusCallback是如何实现的。这是相关C#代码地址：

https://svn.re-motion.org/svn/Remotion/tags/1.11.4.0/Dms/Clients.Windows.WebBrowserControl/

代码是扩展的webbrowser类库，将ExtendedWebBrowser添加到form1后，定义一个实现IWebBrowserDownloadManager接口的类：

’在这里编写实现接收下载的代码

Imports Remotion.Dms.Clients.Windows.WebBrowserControl
Public Class MyDownloadmanager
    Implements IWebBrowserDownloadManager

    Public Sub OnAborted() Implements Remotion.Dms.Clients.Windows.WebBrowserControl.IWebBrowserDownloadManager.OnAborted

    End Sub

    Public Function OnDataAvailable(ByVal buffer() As Byte, ByVal bytesAvailable As Integer) As Boolean Implements Remotion.Dms.Clients.Windows.WebBrowserControl.IWebBrowserDownloadManager.OnDataAvailable

    End Function

    Public Sub OnDownloadCompleted(ByVal success As Boolean, ByVal statusText As String) Implements Remotion.Dms.Clients.Windows.WebBrowserControl.IWebBrowserDownloadManager.OnDownloadCompleted

    End Sub

    Public Function OnProgress(ByVal currentValue As Integer, ByVal totalSize As Integer, ByVal statusText As String) As Boolean Implements Remotion.Dms.Clients.Windows.WebBrowserControl.IWebBrowserDownloadManager.OnProgress

    End Function

    Public Function OnStartDownload(ByVal uri As System.Uri) As Boolean Implements Remotion.Dms.Clients.Windows.WebBrowserControl.IWebBrowserDownloadManager.OnStartDownload

    End Function
End Class

并在form1.load里添加：

Dim mydown as new MyDownloadmanager
ExtendedWebBrowser1.DownloadManager=mydown

如果要转换为VB.net代码的话，注意对 HResultValues.cs的转换就行，注意对uncheched的转换，否则，会报“错误信息为:system.accessviolationexceptio:尝试读取或写入受保护的内存”，这也花了我一天时间去查转换过程中错误出在哪里。

直接使用上面现成的扩展类库，容易实现下载，但我还不知道怎样才能实现能弹出下载进度指示窗口的下载，在Class MyDownloadmanager里实现的下载进度，不知要如何才能传递到一个窗口里显示出来。

2014.3.28：终于知道如何实现上面说的下载进度指示的问题了。

而且也不容易实现多线程下载。

4、实现多线程下载。想法（还未去尝试）：将3的代码嵌入2里面去，在IDownloadManager的download里启动线程进行下载，参考《IE
custom download manager (IEDownloadManager)》

5、在方法2中实现IDownloadManager与方法3中通过webbrowsersite实现IDownloadManager是有不同的，虽然都能接收到IID_IDownloadManager，但方法2中并不是每种下载都能触发IDownloadManager.download方法，而方法3就一定会触发download方法，这个网上有网友提到过不能触发download方法。（2014.4.15更新）