一个使用URLDownloadToFile实现文件下载的类
1 '一个使用URLDownloadToFile函数和IBindStatusCallback接口编写的文件下载类，类名称为URLDownFile。在复制以下代码之前，朋友们需要先先下载Edanmo编写的一个名为olelib.tlb的类型库文件，类的具体代码如下：
2
3 Option Explicit
4
5 Implements IBindStatusCallback
6 Public Event OnProgress(ByVal lMax As Long, ByVal lProgress As Long, ByVal lStatusCode As BINDSTATUS)
7
8 Public Function DownloadFile(ByVal strURL As String, ByVal strFileName As String) As Boolean
9 Dim lResult As Long
10 lResult = olelib.URLDownloadToFile(Nothing, strURL, strFileName, 0, Me)
11 DownloadFile = (lResult = 0)
12 End Function
13 Private Sub IBindStatusCallback_OnProgress(ByVal lProgress As Long, ByVal lMax As Long, ByVal lStatusCode As BINDSTATUS, ByVal szStatusText As Long)
14 On Error Resume Next
15 If lMax > 0 Then
16 RaiseEvent OnProgress(lMax, lProgress, lStatusCode)
17 End If
18 End Sub
19 Private Sub IBindStatusCallback_OnStartBinding(ByVal dwReserved As Long, ByVal pib As IBinding)
20 End Sub
21 Private Sub IBindStatusCallback_OnStopBinding(ByVal hresult As Long, ByVal szError As Long)
22 End Sub
23 Private Sub IBindStatusCallback_GetBindInfo(grfBINDF As olelib.BINDF, pbindinfo As BINDINFO)
24 End Sub
25 Private Function IBindStatusCallback_GetPriority() As Long
26 End Function
27 Private Sub IBindStatusCallback_OnDataAvailable(ByVal grfBSCF As BSCF, ByVal dwSize As Long, pformatetc As FORMATETC, pStgmed As STGMEDIUM)
28 End Sub
29 Private Sub IBindStatusCallback_OnLowResource(ByVal reserved As Long)
30 End Sub
31 Private Sub IBindStatusCallback_OnObjectAvailable(riid As UUID, ByVal pUnk As IUnknown)
32
33
34 调用方法，如果要得到进度事件，则可以在Form或Class里写以下语句：
35
36 Dim WithEvents objUrlDownFile As URLDownFile
37 Private Sub Form_Load()
38 Set objUrlDownFile = New URLDownFile
39 objUrlDownFile.DownloadFile "http://soft31.cn/softimages/soft1.gif", "c:\temp2.jpg"
40 End Sub
41
42 Private Sub objUrlDownFile_OnProgress(ByVal lMax As Long, ByVal lProgress As Long, ByVal lStatusCode As olelib.BINDSTATUS)
43 Debug.Print lMax, lProgress, lStatusCode
44 End Sub
45
46
47 如果只是想实现文件下载，则可以使用以下语句：
48
49 Sub main()
50 Dim objUrlDownFile As New URLDownFile
51 objUrlDownFile.DownloadFile "http://soft31.cn/softimages/soft1.gif", "c:\temp2.jpg"
52 End Sub
2
3 Option Explicit
4
5 Implements IBindStatusCallback
6 Public Event OnProgress(ByVal lMax As Long, ByVal lProgress As Long, ByVal lStatusCode As BINDSTATUS)
7
8 Public Function DownloadFile(ByVal strURL As String, ByVal strFileName As String) As Boolean
9 Dim lResult As Long
10 lResult = olelib.URLDownloadToFile(Nothing, strURL, strFileName, 0, Me)
11 DownloadFile = (lResult = 0)
12 End Function
13 Private Sub IBindStatusCallback_OnProgress(ByVal lProgress As Long, ByVal lMax As Long, ByVal lStatusCode As BINDSTATUS, ByVal szStatusText As Long)
14 On Error Resume Next
15 If lMax > 0 Then
16 RaiseEvent OnProgress(lMax, lProgress, lStatusCode)
17 End If
18 End Sub
19 Private Sub IBindStatusCallback_OnStartBinding(ByVal dwReserved As Long, ByVal pib As IBinding)
20 End Sub
21 Private Sub IBindStatusCallback_OnStopBinding(ByVal hresult As Long, ByVal szError As Long)
22 End Sub
23 Private Sub IBindStatusCallback_GetBindInfo(grfBINDF As olelib.BINDF, pbindinfo As BINDINFO)
24 End Sub
25 Private Function IBindStatusCallback_GetPriority() As Long
26 End Function
27 Private Sub IBindStatusCallback_OnDataAvailable(ByVal grfBSCF As BSCF, ByVal dwSize As Long, pformatetc As FORMATETC, pStgmed As STGMEDIUM)
28 End Sub
29 Private Sub IBindStatusCallback_OnLowResource(ByVal reserved As Long)
30 End Sub
31 Private Sub IBindStatusCallback_OnObjectAvailable(riid As UUID, ByVal pUnk As IUnknown)
32
33
34 调用方法，如果要得到进度事件，则可以在Form或Class里写以下语句：
35
36 Dim WithEvents objUrlDownFile As URLDownFile
37 Private Sub Form_Load()
38 Set objUrlDownFile = New URLDownFile
39 objUrlDownFile.DownloadFile "http://soft31.cn/softimages/soft1.gif", "c:\temp2.jpg"
40 End Sub
41
42 Private Sub objUrlDownFile_OnProgress(ByVal lMax As Long, ByVal lProgress As Long, ByVal lStatusCode As olelib.BINDSTATUS)
43 Debug.Print lMax, lProgress, lStatusCode
44 End Sub
45
46
47 如果只是想实现文件下载，则可以使用以下语句：
48
49 Sub main()
50 Dim objUrlDownFile As New URLDownFile
51 objUrlDownFile.DownloadFile "http://soft31.cn/softimages/soft1.gif", "c:\temp2.jpg"
52 End Sub
