一个使用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    

 

转载于:https://www.cnblogs.com/xxaxx/archive/2009/12/29/1635332.html