امین مستانی
چهارشنبه 01 شهریور 1391, 11:54 صبح
با عرض سلام
خودم خیلی وقت بود دنبال نمونه سورسش میگشتم و بالاخره پیداش کردم.
اینجا قرار میدم تا دوستان هم استفاده کنند.
مشخصات :
Add an Inet control and name it as InetFileDownload
Add a progressbar control and name it as FileDownloadProgress
Add a Command button and name it as cmdDownload
سورس کد :
Option Explicit
Private Sub cmdDownload_Click()
Screen.MousePointer = vbHourglass
FileDownloadProgress.Value = 0
FileDownloadProgress.Visible = True
DownloadFile "http://www.testsite.com/testfile.txt", App.Path & "\testfile.txt"
Screen.MousePointer = vbDefault
Call MsgBox("Download Completed.", vbInformation, App.Title)
FileDownloadProgress.Visible = False
End Sub
Private Sub Form_Load()
FileDownloadProgress.Visible = False
End Sub
Sub DownloadProgress(intPercent As String)
FileDownloadProgress.Value = intPercent
End Sub
Public Sub DownloadFile(strURL As String, strDestination As String)
Const CHUNK_SIZE As Long = 1024
Dim iFile As Integer
Dim lBytesReceived As Long
Dim lFileLength As Long
Dim strHeader As String
Dim b() As Byte
Dim I As Integer
DoEvents
With InetFileDownload
.URL = strURL
.Execute , "GET", , "Range: bytes=" & CStr(lBytesReceived) & "-" & vbCrLf
While .StillExecuting
DoEvents
Wend
strHeader = .GetHeader
End With
strHeader = InetFileDownload.GetHeader("Content-Length")
lFileLength = Val(strHeader)
DoEvents
lBytesReceived = 0
iFile = FreeFile()
Open strDestination For Binary Access Write As #iFile
Do
b = InetFileDownload.GetChunk(CHUNK_SIZE, icByteArray)
Put #iFile, , b
lBytesReceived = lBytesReceived + UBound(b, 1) + 1
DownloadProgress (Round((lBytesReceived / lFileLength) * 100))
DoEvents
Loop While UBound(b, 1) > 0
Close #iFile
End Sub
یا علی
خودم خیلی وقت بود دنبال نمونه سورسش میگشتم و بالاخره پیداش کردم.
اینجا قرار میدم تا دوستان هم استفاده کنند.
مشخصات :
Add an Inet control and name it as InetFileDownload
Add a progressbar control and name it as FileDownloadProgress
Add a Command button and name it as cmdDownload
سورس کد :
Option Explicit
Private Sub cmdDownload_Click()
Screen.MousePointer = vbHourglass
FileDownloadProgress.Value = 0
FileDownloadProgress.Visible = True
DownloadFile "http://www.testsite.com/testfile.txt", App.Path & "\testfile.txt"
Screen.MousePointer = vbDefault
Call MsgBox("Download Completed.", vbInformation, App.Title)
FileDownloadProgress.Visible = False
End Sub
Private Sub Form_Load()
FileDownloadProgress.Visible = False
End Sub
Sub DownloadProgress(intPercent As String)
FileDownloadProgress.Value = intPercent
End Sub
Public Sub DownloadFile(strURL As String, strDestination As String)
Const CHUNK_SIZE As Long = 1024
Dim iFile As Integer
Dim lBytesReceived As Long
Dim lFileLength As Long
Dim strHeader As String
Dim b() As Byte
Dim I As Integer
DoEvents
With InetFileDownload
.URL = strURL
.Execute , "GET", , "Range: bytes=" & CStr(lBytesReceived) & "-" & vbCrLf
While .StillExecuting
DoEvents
Wend
strHeader = .GetHeader
End With
strHeader = InetFileDownload.GetHeader("Content-Length")
lFileLength = Val(strHeader)
DoEvents
lBytesReceived = 0
iFile = FreeFile()
Open strDestination For Binary Access Write As #iFile
Do
b = InetFileDownload.GetChunk(CHUNK_SIZE, icByteArray)
Put #iFile, , b
lBytesReceived = lBytesReceived + UBound(b, 1) + 1
DownloadProgress (Round((lBytesReceived / lFileLength) * 100))
DoEvents
Loop While UBound(b, 1) > 0
Close #iFile
End Sub
یا علی