一个VB下载文件函数

下载文件函数，专用于VB编程使用，函数参数说明：sUrl：网页地址；FileName：本地保存的文件名，函数代码发上来，以备后用：

Public Function inteDownloadFile(ByVal sUrl As String, ByVal Filename As String) As String

    Dim fso, aso, http, Current, Total

    Dim start, i

    Dim temp As String, range As String

    Dim Dnbyte

    Dnbyte = 20480 '20K 每次下载的字节数n*1024

    If Not Left(sUrl, 7) = "http://" Then sUrl = "http://" & sUrl

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set aso = CreateObject("ADODB.Stream")

    Set http = CreateObject("Microsoft.XMLHTTP")

    If Dir(Filename) <> "" Then Kill Filename

    fso.createtextfile(Filename).Close

    aso.Type = 1 '数据流类型设为字节'

    aso.open

    aso.LoadFromFile Filename '打开文件'

    start = 0

    Current = 0

    Do

        http.open "GET", sUrl, True

        http.setRequestHeader "Range", "bytes=" & start & "-" & CStr(start + Dnbyte)

        http.setRequestHeader "Content-Type:", "application/octet-stream"

        http.send '构造完数据包就开始发送'

        For i = 1 To 120 '循环等待'

            If http.ReadyState = 4 Then Exit For '状态4表示数据接受完成'

            Sleep 500 '等待500ms'

            DoEvents

        Next

        If http.Status = 416 Then mDownLoaddComPlete = True: Exit Do '下载完成

        If http.Status = 403 Then

            inteDownloadFile = "连接数过多"

            Exit Do

        End If

        If http.Status = 404 Then

            inteDownloadFile = "文件无法找到"

            Exit Do

        End If

        

        If Not http.ReadyState = 4 Then

            inteDownloadFile = "下载文件超时"

            Exit Do

        End If

        If http.Status > 299 Then

            inteDownloadFile = "未知错误：" & http.StatusText & "(" & http.Status & ")"

            Exit Do

        End If

        If Not http.Status = 206 Then

            inteDownloadFile = "不支持断点续传"

            Exit Do

        End If

        aso.position = start '设置文件指针初始位置'

        aso.write http.responseBody '写入数据'

        range = http.getResponseHeader("Content-Range") '获得http头中的"Content-Range"'

        If range = "" Then MsgBox "无法获取文件大小！", vbInformation, "错误006" '没有它就不知道下载完了没有'

        temp = Mid(range, InStr(range, "-") + 1) 'Content-Range是类似123-456/789的样子'

        Current = CLng(Left(temp, InStr(temp, "/") - 1))  '123是开始位置，456是结束位置'

        Total = CLng(Mid(temp, InStr(temp, "/") + 1)) '789是文件总字节数'

        inteDownloadFile = Current & "/" & Total

        If Total - Current = 1 Then mDownLoaddComPlete = True: Exit Do '结束位置比总大小少1就表示传输完成了'

        start = start + Dnbyte '继续下载

        DoEvents

    Loop While True

    aso.SaveToFile Filename, 2 '保存文件

    aso.Close

    Set aso = Nothing

    Set fso = Nothing

    If mDownLoaddComPlete = True Then inteDownloadFile = "下载完成"

End Function