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

VB 2020-02-11

写这篇文章之前，首先十分多谢 蒋晟 ，其次也谢谢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,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,cancel)
        End Sub

        Public Sub NewWindow3(pdisp As Object,ByRef cancel As Boolean,ByRef URLContext As Object,ByRef URL As Object) Implements DWebbrowserEvents2.NewWindow3
            _browser.OnBeforeNewWindow(CType(URL,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](),Out()> ByRef cancel As Boolean,<[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/

实现接口

 ImportsSystem.Runtime.InteropServices
 ImportsSystem.Runtime.InteropServices.ComTypes
 PublicclassForm1
 ImplementsIServiceProvider,IOleClientSite,IAuthenticate,IDownloadManager
 PublicSharedIID_IDownloadManagerAsNewGuid("988934A4-064B-11D3-BB80-00104B35E7F9")
 PublicSharedIID_IAuthenticateAsNewGuid("79eac9d0-baf9-11ce-8c82-00aa004ba90b")
 PublicConstINET_E_DEFAULT_ACTIONAsInteger=&H800C0011
 PublicConstS_OKAsInteger=0
 PrivateSubForm1_Load(senderAsSystem.Object,eAsSystem.EventArgs)HandlesMyBase.Load
 Me.Webbrowser1.Navigate("about:blank")
 DimocAsIOleObject=DirectCast(Me.Webbrowser1.ActiveXInstance,IOleObject)
 oc.SetClientSite(DirectCast(Me,IOleClientSite))
 EndSub
 PublicSubGetContainer(ppContainerAsObject)ImplementsIOleClientSite.GetContainer
 ppContainer=Me
 EndSub
 PublicSubGetMoniker(dwAssignAsUInteger,dwWhichMonikerAsUInteger,ppmkAsObject)ImplementsIOleClientSite.GetMoniker
 EndSub
 PublicSubOnShowWindow(fShowAsBoolean)ImplementsIOleClientSite.OnShowWindow
 EndSub
 PublicSubRequestNewObjectLayout()ImplementsIOleClientSite.RequestNewObjectLayout
 EndSub
 PublicSubSaveObject()ImplementsIOleClientSite.SaveObject
 EndSub
 PublicSubShowObject()ImplementsIOleClientSite.ShowObject
 EndSub
 PublicFunctionQueryService(ByRefguidServiceAsSystem.Guid,ByRefriidAsSystem.Guid,ByRefppvObjectAssystem.intPtr)AsIntegerImplementsIServiceProvider.QueryService
 IfguidService.Compareto(IID_IAuthenticate)=0AndAlsoriid.Compareto(IID_IAuthenticate)=0Then
 ppvObject=Marshal.GetComInterfaceForObject(Me,GetType(IAuthenticate))
 ReturnS_OK
 EndIf
 IfguidService.Compareto(IID_IDownloadManager)=0AndAlsoriid.Compareto(IID_IDownloadManager)=0Then
 ppvObject=Marshal.GetComInterfaceForObject(Me,GetType(IDownloadManager))
 ReturnS_OK
 EndIf
 ppvObject=NewIntPtr()
 ReturnINET_E_DEFAULT_ACTION
 EndFunction
 PrivateSubButton1_Click(senderAsSystem.Object,eAsSystem.EventArgs)HandlesButton1.Click
 'Me.Webbrowser1.Navigate("<atitle="Externelink"class="bbc_url"href="http://Tradecom.websub.be/bgc_config"rel="nofollowexternal">http://Tradecom.webs....be/bgc_config"</a>)
 Me.Webbrowser1.Navigate("<atitle="Externelink"class="bbc_url"href="http://www.codeproject.com/Articles/229280/VBAExtend"rel="nofollowexternal">http://www.codeproje...9280/VBAExtend"</a>)
 EndSub
 PublicFunctionAuthenticate(ByRefphwndAssystem.intPtr,ByRefpszUsernameAssystem.intPtr,ByRefpszPasswordAssystem.intPtr)AsIntegerImplementsIAuthenticate.Authenticate
 phwnd=Me.Handle
 pszUsername=Marshal.StringToCoTaskMemAuto("username")
 pszPassword=Marshal.StringToCoTaskMemAuto("password")
 ReturnS_OK
 EndFunction
 
 'PublicFunctionDownload(pmkAssystem.intPtr,pbcAssystem.intPtr,dwBindVerbAsUInteger,grfBINDFAsInteger,pBindInfoAssystem.intPtr,pszHeadersAsstring,pszRedirAsstring,uiCPAsUInteger)AsIntegerImplementsIDownloadManager.Download
 'MsgBox(pszRedir)
 'ReturnS_OK
 'EndFunction
 PublicFunctionDownload(pmkAsIMoniker,pbcAsIBindCtx,uiCPAsUInteger)AsIntegerImplementsIDownloadManager.Download
 DimnameAsstring=String.Empty
 pmk.GetdisplayName(pbc,nothing,name)
 MsgBox(name)
 ReturnS_OK
 EndFunction
 EndClass
 ClassEntryPoint
 <STAThread()>
 SharedSubMain()
 Application.Run(NewForm1())
 EndSub
 EndClass

定义接口

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 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"),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更新）



相关文章

VB Format函数
Format[$] ( expr [ , fmt ] ) format 返回变体型 format$ 强...
vb6/ASP FORMAT MM/DD/YYYY
VB6或者ASP 格式化时间为 MM/dd/yyyy 格式，竟然没有好的办...
VB.net 捕获项目全局异常
在项目中添加如下代码：新建窗口来显示异常信息。 Namespace...
实现用VB.Net/(C#)开发K/3 BOS 插件的真正可行方法
转了这一篇文章，原来一直想用C#做k3的插件开发，vb没有C#用...
vb，wps，excel 分裂
Sub 分列() ‘以空格为分隔符，连续空格只算1个。对所选...
VB文件 hash 查看器
  窗体代码 1 Private Sub Text1_OLEDragDrop(Data As Dat...