下载文件例子!!!!

class
'-------------------------------------------------------------
Option Explicit
Implements IBindStatusCallback

'获得字符串的函数
Private Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long

Private Declare Function lstrcpyA Lib "kernel32" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
Private Declare Function lstrcpyW Lib "kernel32" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long
  
'下载函数
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

'控制下载的接口
Private m_oBind As IBinding
'是否在下载
Private m_fDownloading As Boolean
'对于下载控制接口的引用数
Private m_lRefCount As Long

'下载进度的事件
Public Event OnProgress(ByVal lProgress As Long, ByVal lMaxProgress As Long, ByVal lStatusCode As Long, ByVal sStatusText As String)

'初始化
Private Sub Class_Initialize()
    m_fDownloading = False
    m_lRefCount = 0
End Sub

'结束
Private Sub Class_Terminate()
    If m_lRefCount = 1 Then
        If Not m_oBind Is Nothing Then m_oBind.Release
    End If
    m_fDownloading = False
End Sub

'开始下载
Public Function StartDownloading(ByVal sSrc As String, ByVal sDest As String) As Boolean
    '如果已经在下载则退出
    If m_fDownloading Then Exit Function
   
    Dim oBindCallback As IBindStatusCallback
   
    '获得IBindStatusCallback接口对象
    Set oBindCallback = Me
   
    '开始下载
    StartDownloading = (URLDownloadToFile(ObjPtr(Me), sSrc, sDest, 0, ObjPtr(oBindCallback)) = 0)
End Function

'中止下载
Public Sub AbortDownloading()
    On Error Resume Next
    If m_lRefCount = 1 Then
        If Not m_oBind Is Nothing Then m_oBind.Abort
    End If
    m_fDownloading = False
End Sub

'从字符指针获得字符串
Public Function StrFromPtr(ByVal lpString As Long, Optional fUnicode As Boolean = False) As String
    On Error Resume Next
    If fUnicode Then
        StrFromPtr = String(lstrlenW(lpString), Chr(0))
        lstrcpyW StrPtr(StrFromPtr), ByVal lpString
    Else
        StrFromPtr = String(lstrlenA(lpString), Chr(0))
        lstrcpyA ByVal StrFromPtr, ByVal lpString
    End If
End Function

'*********************************************************************************************************************************************
'IBindStatusCallback接口成员
'*********************************************************************************************************************************************
Private Sub IBindStatusCallback_GetBindInfo(grfBINDF As Long, pbindinfo As Long)
'
End Sub

Private Sub IBindStatusCallback_GetPriority(pnPriority As Long)
'
End Sub

Private Sub IBindStatusCallback_OnDataAvailable(ByVal grfBSCF As Long, ByVal dwSize As Long, pformatetc As Long, pstgmed As Long)
'
End Sub

Private Sub IBindStatusCallback_OnLowResource(ByVal reserved As Long)
'
End Sub

Private Sub IBindStatusCallback_OnObjectAvailable(ByVal riid As Long, ByVal punk As URLMonLib.IUnknownVB)
'
End Sub

'下载进度
Private Sub IBindStatusCallback_OnProgress(ByVal ulProgress As Long, ByVal ulProgressMax As Long, ByVal ulStatusCode As Long, ByVal szStatusText As Long)
    RaiseEvent OnProgress(ulProgress, ulProgressMax, ulStatusCode, StrFromPtr(szStatusText, True))
    DoEvents
End Sub

'开始下载绑定
Private Sub IBindStatusCallback_OnStartBinding(ByVal dwReserved As Long, ByVal pib As URLMonLib.IBinding)
    m_fDownloading = True
    Set m_oBind = pib
    m_oBind.AddRef
    m_lRefCount = 1
End Sub

'结束下载绑定
Private Sub IBindStatusCallback_OnStopBinding(ByVal hresult As Long, ByVal szError As Long)
    m_fDownloading = False
    If m_lRefCount = 1 Then
        m_oBind.Release
        m_lRefCount = 0
    End If
End Sub

Private Sub IBindStatusCallback_RemoteGetBindInfo(grfBINDF As Long, pbindinfo As Long, pstgmed As Long)
'
End Sub

Private Sub IBindStatusCallback_RemoteOnDataAvailable(ByVal grfBSCF As Long, ByVal dwSize As Long, pformatetc As Long, pstgmed As Long)
'
End Sub

'-------------------------------------------------------------
end class



'form1
'-------------------------------------------------------------------
Option Explicit
Private WithEvents m_oFileDownload As CFileDownload

Private Sub cmdStart_Click()
    pb.Value = 0
    cmdStart.Enabled = False
    cmdStop.Enabled = True
    Me.Caption = "下载中……"
   
    If m_oFileDownload.StartDownloading(txtSrc.Text, txtDest.Text) Then
        MsgBox "下载成功！"
    Else
        MsgBox "下载失败！"
    End If
       
    cmdStart.Enabled = True
    cmdStop.Enabled = False
    Me.Caption = "空闲中"
    lblProgress.Caption = "下载进度"
End Sub

Private Sub cmdStop_Click()
    cmdStart.Enabled = True
    cmdStop.Enabled = False
    Me.Caption = "空闲中"
    lblProgress.Caption = "下载进度"
    m_oFileDownload.AbortDownloading
End Sub

Private Sub Form_Load()
    Set m_oFileDownload = New CFileDownload
   
    Me.Caption = "空闲中"
    lblProgress.Caption = "下载进度"
    cmdStart.Enabled = True
    cmdStop.Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set m_oFileDownload = Nothing
End Sub

Private Sub m_oFileDownload_OnProgress(ByVal lProgress As Long, ByVal lMaxProgress As Long, ByVal lStatusCode As Long, ByVal sStatusText As String)
    Dim bPercent As Long
   
    If lMaxProgress = 0 Then
        bPercent = 0
    Else
        bPercent = Int(lProgress / lMaxProgress * 100)
    End If
   
    pb.Value = bPercent
    lblProgress.Caption = "已下载" & CStr(bPercent) & "%"
   
    txtStatusText.Text = txtStatusText.Text & sStatusText
    txtStatusText.Text = txtStatusText.Text & vbCrLf
    txtStatusText.SelStart = Len(txtStatusText.Text)
End Sub