疑問 - 如何在URLDownloadToFile下載時得知進度

[rank]

--------------------
閱讀本主題的最佳解答
--------------------


爬了不少文始終不知道該如何實做IBindStatusCallback這介面
特地來問問看,是否有誰會使用

[飛行船大大]

作者: rank

爬了不少文始終不知道該如何實做IBindStatusCallback這介面
特地來問問看,是否有誰會使用

你vb是用vb inet ?
若是~ 我知道如何設計 根本不必IBindStatusCallback.

[rank]

作者: 飛行船大大

你vb是用vb inet ?
若是~ 我知道如何設計 根本不必IBindStatusCallback.

我是用VB6,如果是VB.NET最簡單也煩請告訴我
我有可能會換開發軟體,先謝謝飛行船大大

>>你vb是用vb inet ?
這一句我還真有點看不懂,我是用URLDownloadToFile函式去下載檔案
inet好像也可以下,但我沒用

總之有任何做法,我都願意嘗試

[飛行船大大]

大部份的人都用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

[rank]

請問飛行船大大
Implements olelib.IBindStatusCallback
我這一行一直編譯不過到底是發生什麼原因
一直無法通過

[rank]

我找到元件了,可以跑了
可是問題來了,我的進度表那裡一直弄不好,能否幫我看看
一直常發生溢位和錯誤

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_GetBindInfo(grfBINDF As olelib.BINDF, pbindinfo As olelib.BINDINFO)

End Sub

Private Function IBindStatusCallback_GetPriority() As Long

End Function

Private Sub IBindStatusCallback_OnDataAvailable(ByVal grfBSCF As olelib.BSCF, ByVal dwSize As Long, pformatetc As olelib.FORMATETC, pStgmed As olelib.STGMEDIUM)

End Sub

Private Sub IBindStatusCallback_OnLowResource(ByVal reserved As Long)

End Sub

Private Sub IBindStatusCallback_OnObjectAvailable(riid As olelib.UUID, ByVal pUnk As stdole.IUnknown)

End Sub

Private Sub IBindStatusCallback_OnProgress(ByVal ulProgress As Long, ByVal ulProgressMax As Long, ByVal ulStatusCode As olelib.BINDSTATUS, ByVal szStatusText As Long)
   ProgressBar1.Min = 0
   ProgressBar1.Max = 100
    If ulProgressMax <> 0 Then
        ProgressBar1.Value = CInt(100 * (ulProgress / ulProgressMax))
    End If
    If ulProgressMax <> 0 Then
        Debug.Print ulProgress
        Debug.Print ulProgressMax
        Debug.Print ulProgress / ulProgressMax
    End If
End Sub
Private Sub Command1_Click()
StartTheStinkinDownLoad "http://www.google.com.tw/", "C:/abc.txt"
End Sub

Private Sub IBindStatusCallback_OnStartBinding(ByVal dwReserved As Long, ByVal pib As olelib.IBinding)

End Sub

Private Sub IBindStatusCallback_OnStopBinding(ByVal hresult As Long, ByVal szError As Long)

End Sub

[mraaa711128]

作者: rank

我找到元件了,可以跑了
可是問題來了,我的進度表那裡一直弄不好,能否幫我看看
一直常發生溢位和錯誤

是什麼樣情況下會發生溢位
可否說明一下??
是跑到最後了才發生
還是不一定??

[rank]

作者: mraaa711128

是什麼樣情況下會發生溢位
可否說明一下??
是跑到最後了才發生
還是不一定??

ProgressBar1.Value = CInt(100 * (ulProgress / ulProgressMax))
是這一行會發生錯誤,照理說ulProgressMax應該會比ulProgress大
但事實跑起來並不然,使得我的ProgressBar1.Value 的值超出100而超出範圍造成錯誤
而且從頭到尾的數值改變只有變動一次...我把我Debug 印的PO上來好了

[1] Progress event received: 0 of 0, StatusCode: 34
[2] Progress event received: 0 of 0, StatusCode: 1
[3] Progress event received: 0 of 0, StatusCode: 2
[4] Progress event received: 0 of 0, StatusCode: 11
[5] Progress event received: 0 of 0, StatusCode: 24
[6] Progress event received: 0 of 0, StatusCode: 13
[7] Progress event received: 6779 of 3115, StatusCode: 4
[8] Progress event received: 6779 of 3115, StatusCode: 14
[9] Progress event received: 6779 of 3115, StatusCode: 6

以上就是我Debug印出來的狀態

[rank]

可以了!好像下載google的頁面會怪怪的
如果有後續解決方案,麻煩各位大大告知