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