查看單個文章
舊 2008-09-29, 01:24 AM   #4 (permalink)
飛行船大大
註冊會員
 
飛行船大大 的頭像
榮譽勳章
UID - 282126
在線等級: 級別:15 | 在線時長:286小時 | 升級還需:34小時級別:15 | 在線時長:286小時 | 升級還需:34小時級別:15 | 在線時長:286小時 | 升級還需:34小時級別:15 | 在線時長:286小時 | 升級還需:34小時級別:15 | 在線時長:286小時 | 升級還需:34小時
註冊日期: 2007-10-09
文章: 178
精華: 0
現金: 328 金幣
資產: 7328 金幣
預設



大部份的人都用winsock, inet來設計 比較少人用URLDownloadToFile
既然你inet不熟 ,我就 回答這個URLDownloadToFile

表單先加一個 進度條ProgressBar1 一個Label1
主要是在表單加上 一行Implements olelib.IBindStatusCallback
和以下2個事件 就可以了.
語法:
Implements olelib.IBindStatusCallback
Private Function StartTheStinkinDownLoad(ByVal File2DownLoad As String, ByVal File2Save As String) As Boolean

  Dim DownLoadResult As Long
  DownLoadResult = olelib.URLDownloadToFile(Nothing, File2DownLoad, File2Save, 0, Me)
    StartTheStinkinDownLoad = (DownLoadResult = olelib.S_OK)
End Function

Private Sub IBindStatusCallback_OnProgress(ByVal ulProgress As Long, ByVal ulProgressMax As Long, ByVal ulStatusCode As olelib.BINDSTATUS, ByVal szStatusText As Long)
    On Error GoTo BadDeal
    If ulProgressMax <= 0 Then Exit Sub
     ProgressBar1.Max = CSng(ulProgressMax) ' set the progress bar's max value after it is known for sure
     ProgressBar1.Value = CSng(ulProgress) ' set the current level of progress
    DoEvents 'force a refresh... even though this slows things down
    
Exit Sub
BadDeal:
    Form1.Text3.Text = Form1.Text3.Text & "下載出錯: " & ulProgress & "/" & ProgressBar1.Value & "/" & ulProgressMax & "/" & ProgressBar1.Max & vbCrLf
    Resume Next
End Sub
語法:
Public Function ShowDownLoad(FileList As String, Optional Owner As Object)
    Dim i, X As Integer
   i = Split(FileList, ",")

   Me.Print "正在下載... 請稍候..."
   Label1.Caption = "檢查複製緩存..."
   If IsMissing(Owner) = False Then
      Me.Show
   Else
      Me.Show vbModeless, Owner
   End If
   Me.Refresh
   Dim File2DownLoad As String, File2Save As String, DeleteCache As Boolean, TopLimit As Integer, TempDelete As String, OffSet As Integer
   TopLimit = (UBound(i) - 2) / 3
   OffSet = 0
   For X = 0 To TopLimit
      File2DownLoad = i(OffSet)
      File2Save = i(OffSet + 1)
      TempDelete = i(OffSet + 2)
      If TempDelete = "1" Then
         DeleteCache = True
      Else
         DeleteCache = False
      End If
      OffSet = OffSet + 3
      ProgressBar1.Value = 0
      Form1.Text3.Text = Form1.Text3.Text & "開始下載文件..." & vbCrLf
      Form1.Text3.Text = Form1.Text3.Text & File2DownLoad & vbCrLf
      If DeleteCache Then
         If DeleteUrlCacheEntry(File2DownLoad) = 1 Then
            Form1.Text3.Text = Form1.Text3.Text & "找到上次下載緩存文件刪除..." & vbCrLf
         Else
            Form1.Text3.Text = Form1.Text3.Text & "沒有緩存文件存在" & vbCrLf
         End If
      End If
      Label1.Caption = File2DownLoad
      If StartTheStinkinDownLoad(File2DownLoad, File2Save) Then
         Form1.Text3.Text = Form1.Text3.Text & "文件下載完畢: " & File2DownLoad & vbCrLf & vbCrLf
         ShowDownLoad = True
      Else
         Form1.Text3.Text = Form1.Text3.Text & "文件下載失敗!" & vbCrLf
         ShowDownLoad = False
      End If
   Next
   Form1.Text3.Text = Form1.Text3.Text & "結束下載文件..." & vbCrLf
   
   Unload Me
   Set frmDnLoad = Nothing
   
End Function
呼叫的方式: 在Form1 中按Command1 即可

Private Sub Command1_Click()
Dim FileList As String
FileList = Text1.Text & "," & Text2.Text & "," & "1"
Call frmDnLoad.ShowDownLoad(FileList, Me)

End Sub

此帖於 2008-09-29 01:49 AM 被 飛行船大大 編輯.
飛行船大大 目前離線  
送花文章: 185, 收花文章: 64 篇, 收花: 146 次
回覆時引用此帖
向 飛行船大大 送花的會員:
rank (2008-09-29)
感謝您發表一篇好文章