利用Winsock下載檔案(支援斷點續傳)

來源:互聯網
上載者:User
下載 第一步,建立工程,引用Winsock(Visual Basic最好打SP6,否則MS有一個Bug),在此省略

第二步,具體實現代碼步驟1:發送請求
說明:
(1)這裡簡單採用了判斷是否已經有同名檔案表示是否要斷點續傳
(2)下載的地址,大小和已下載位元組數也只是簡單地存在ini檔案中,更安全的做法本文不作討論
有興趣的朋友可以聯絡我

'--------------------------------------------------------------------------------
'   Name:DownloadFile
'   Author:Reker 2004/3/20
'   Desc:串連遠端主機,發送接收檔案請求,等待遠端主機響應
'   Params:None
'   History:None
'--------------------------------------------------------------------------------
Private Sub DownloadFile()
    On Error Resume Next
    StartTime = Time()
    With WinSck
        .RemoteHost = Host '遠端主機地址
        .RemotePort = 80
        .Connect
        '等待伺服器串連相應
        Do While .State <> sckConnected
            DoEvents: DoEvents: DoEvents: DoEvents
            '20秒逾時
            If DateDiff("s", StartTime, Time()) > 20 Then
                ShowInfo "連線逾時"
                .Close
                Exit Sub
            End If
        Loop
        '發送下載檔案請求
        '此處使用HTTP/1.0協議
        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 '是否已經存在下載檔案
            Dim confirm
            confirm = MsgBox("已經存在檔案,是否斷點續傳?", vbYesNo + vbQuestion, "提示")
            If confirm = vbYes Then
                DownPosition = ""
                If Not oFileCtrl.ReadKeyFromIni("Update", "DownSize", AppPath + "Update.ini", DownPosition) Then
                '讀取上次下載的位元組數
                    MsgBox "讀取大小錯誤", vbInformation, "提示"
                End If
                '發送斷點續傳請求
                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 & "下載檔案出錯:" & Err.Description
        lblProcessResult.Refresh
    End If
End Sub


第二步,具體實現代碼步驟2:接收資料
'--------------------------------------------------------------------------------
'   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 '僅第一次計算,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) '計算檔案的長度
            StartTime = Timer() '儲存開始下載的時間
            ProgssBar.Max = FileSizeByte '設定進度條
            FileSize = FormatNumber(FileSizeByte / 1024, 2) '以KB表示
            ShowInfo "本次下載的檔案共" + CStr(FileSize) + "KB..."
        End If
    End If
    '從伺服器響應返回的資料尋找下載檔案的起始位置
    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     
    '已下載檔案長度,需減去響應的檔案頭長度
    dblDownloadSpeed = FormatNumber(FormatNumber(FileSizeHaveDown / 1024, 2) / (FormatNumber((Timer() - StartTime), 4)), 2)  '計算下載速率 KB/S
    If dblDownloadSpeed <> 0 Then  '計算剩餘下載的時間
        sRestTime = GetRestTime(CLng((FileSize - (FileSizeHaveDown) / 1024) / dblDownloadSpeed)) '此過程略,可以刪除此段代碼
        labRestTime.Caption = "剩餘時間:º" + sRestTime
        labRestTime.Refresh
    End If
    labDownloadSpeed.Caption = CStr(dblDownloadSpeed) + " kb/s"
    labDownloadSpeed.Refresh
    ProgssBar.Value = FileSizeHaveDown
    '寫資料
    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 & 擷取資料出錯:" & Err.Description
        lblProcessResult.Refresh
    End If
End Sub

相關文章

Beyond APAC's No.1 Cloud

19.6% IaaS Market Share in Asia Pacific - Gartner IT Service report, 2018

Learn more >

Apsara Conference 2019

The Rise of Data Intelligence, September 25th - 27th, Hangzhou, China

Learn more >

Alibaba Cloud Free Trial

Learn and experience the power of Alibaba Cloud with a free trial worth $300-1200 USD

Learn more >

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。