|
利用Winsock下載文件（支持?jǐn)帱c(diǎn)續(xù)傳）
第一步，建立工程,，引用Winsock（Visual Basic最好打SP6,否則MS有一個(gè)Bug）,在此省略
第二步,，具體實(shí)現(xiàn)代碼步驟1：發(fā)送請求
說明：
(1)這里簡單采用了判斷是否已經(jīng)有同名文件表示是否要斷點(diǎn)續(xù)傳
(2)下載的地址，大小和已下載字節(jié)數(shù)也只是簡單地存在ini文件中,，更安全的做法本文不作討論
有興趣的朋友可以聯(lián)系我
'--------------------------------------------------------------------------------
' Name:DownloadFile
' Author:Reker 2004/3/20
' Desc:連接遠(yuǎn)端主機(jī),，發(fā)送接收文件請求，等待遠(yuǎn)端主機(jī)響應(yīng)
' Params:None
' History:None
'--------------------------------------------------------------------------------
Private Sub DownloadFile()
On Error Resume Next
StartTime = Time()
With WinSck
.RemoteHost = Host '遠(yuǎn)端主機(jī)地址
.RemotePort = 80
.Connect
'等待服務(wù)器連接相應(yīng)
Do While .State <> sckConnected
DoEvents: DoEvents: DoEvents: DoEvents
'20秒超時(shí)
If DateDiff("s", StartTime, Time()) > 20 Then
ShowInfo "連接超時(shí)"
.Close
Exit Sub
End If
Loop
'發(fā)送下載文件請求
'此處使用HTTP/1.0協(xié)議
strCommand = "GET " + UpdateURL + " HTTP/1.0" + VBCrLf '下載地址
strCommand = strCommand + "Accept: */*" + vbCrLf '這句可以不要
strCommand = strCommand + "Accept: text/html" + vbCrLf '這句可以不要
strCommand = strCommand + vbCrLf
strCommand = strCommand & "Host: " & Host & vbCrLf
If Dir(SaveFileName) <> "" Then '是否已經(jīng)存在下載文件
Dim confirm
confirm = MsgBox("已經(jīng)存在文件,，是否斷點(diǎn)續(xù)傳?", vbYesNo + vbQuestion, "提示")
If confirm = vbYes Then
DownPosition = ""
If Not oFileCtrl.ReadKeyFromIni("Update", "DownSize", AppPath + "Update.ini", DownPosition) Then
'讀取上次下載的字節(jié)數(shù)
MsgBox "讀取大小錯(cuò)誤", vbInformation, "提示"
End If
'發(fā)送斷點(diǎn)續(xù)傳請求
strCommand = strCommand & "Range: bytes=" & CLng(DownPosition) & "-" & vbCrLf
Else
Kill SaveFileName '刪除原文件
End If
End If
strCommand = strCommand & "Connection: Keep-Alive" & vbCrLf
strCommand = strCommand & vbCrLf
.SendData strCommand
End With
If Err Then
lblProcessResult.Caption = lblProcessResult.Caption & vbCrLf & vbCrLf & "下載文件出錯(cuò)：" & Err.Description
lblProcessResult.Refresh
End If
End Sub
第二步,，具體實(shí)現(xiàn)代碼步驟2：接收數(shù)據(jù)
'--------------------------------------------------------------------------------
' Name:Winsck_DataArrival
' Author:Reker 2004/3/20
' Desc:略
' Params:略
' Return:None
' History:None
'--------------------------------------------------------------------------------
Private Sub Winsck_DataArrival(ByVal bytesTotal As Long)
On Error Resume Next
'DoEvents: DoEvents
Dim ByteData() As Byte
WinSck.GetData ByteData(), vbByte
ReceiveData = ReceiveData & StrConv(ByteData(), vbUnicode)
If InStr(1, ReceiveData, "Content-Length:") > 0 And FileSize = 0 Then '僅第一次計(jì)算,FileSize=0
Dim pos1 As Long, pos2 As Long
pos1 = InStr(1, ReceiveData, "Content-Length:")
pos2 = InStr(pos1 + 16, ReceiveData, vbCrLf)
If pos2 > pos1 Then
FileSizeByte = Mid(ReceiveData, pos1 + 16, pos2 - pos1 - 16) '計(jì)算文件的長度
StartTime = Timer() '保存開始下載的時(shí)間
ProgssBar.Max = FileSizeByte '設(shè)置進(jìn)度條
FileSize = FormatNumber(FileSizeByte / 1024, 2) '以KB表示
ShowInfo "本次下載的文件共" + CStr(FileSize) + "KB..."
End If
End If
'從服務(wù)器響應(yīng)返回的數(shù)據(jù)查找下載文件的起始位置
If FileHeaderLen = 0 Then
For i = 0 To UBound(ByteData()) - 3
If ByteData(i) = 13 And ByteData(i + 1) = 10 And ByteData(i + 2) = 13 And ByteData(i + 3) = 10 Then
StartPos = i + 4 '將文件頭的長度保存下來
FileHeaderLen = StartPos
Exit For
End If
'DoEvents
Next i
End If
FileSizeHaveDown = bytesTotal + FileSizeHaveDown - FileHeaderLen
'已下載文件長度，需減去響應(yīng)的文件頭長度
dblDownloadSpeed = FormatNumber(FormatNumber(FileSizeHaveDown / 1024, 2) / (FormatNumber((Timer() - StartTime), 4)), 2) '計(jì)算下載速率 KB/S
If dblDownloadSpeed <> 0 Then '計(jì)算剩余下載的時(shí)間
sRestTime = GetRestTime(CLng((FileSize - (FileSizeHaveDown) / 1024) / dblDownloadSpeed)) '此過程略,，可以刪除此段代碼
labRestTime.Caption = "剩余時(shí)間：o" + sRestTime
labRestTime.Refresh
End If
labDownloadSpeed.Caption = CStr(dblDownloadSpeed) + " kb/s"
labDownloadSpeed.Refresh
ProgssBar.Value = FileSizeHaveDown
'寫數(shù)據(jù)
Fnum = FreeFile()
Open SaveFileName For Binary Lock Write As #Fnum
If LOF(Fnum) > 0 Then
Seek #Fnum, LOF(Fnum) + 1
End If
If StartPos > 0 Then
For i = StartPos To UBound(ByteData())
Put #Fnum, , ByteData(i)
Next i
Else
Put #Fnum, , ByteData()
End If
Close #Fnum
If Err Then
lblProcessResult.Caption = lblProcessResult.Caption & vbCrLf & 獲取數(shù)據(jù)出錯(cuò)：" & Err.Description
lblProcessResult.Refresh
End If
End Sub
參考一下
|
