史萊姆論壇 - 如何在URLDownloadToFile下載時得知進度

史萊姆論壇 (http://forum.slime.com.tw/)

- 程式語言討論區 (http://forum.slime.com.tw/f76.html)

- - 如何在URLDownloadToFile下載時得知進度 (http://forum.slime.com.tw/thread236211.html)

如何在URLDownloadToFile下載時得知進度

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

引用:

作者: rank (文章 2032947)

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

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

引用:

作者: 飛行船大大 (文章 2032985)

你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

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

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

語法:

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

引用:

作者: rank (文章 2033732)

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

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

引用:

作者: mraaa711128 (文章 2033910)

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

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印出來的狀態

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