ASP下载远程文件(带进度条,支持断点续传)

<%
Option Explicit
Server.Scripttimeout = 24*60*60'脚本超时设置,这里设为24小时
Class Download
'---------------------------------
'作者:午夜狂龙(Madpolice)
'优化整理:新兴网络 - http://www.newxing.com/
'---------------------------------
    Public RefererUrl '来路地址
    Public bandwidth '带宽大小
    Private RemoteFileUrl'远程文件路径
    Private BlockSize'分段下载的块大小
    Private BlockTimeout'下载块的超时时间(秒)
    Private PercentTableWidth
    Private LocalFileFullPhysicalPath'本地文件在硬盘上的绝对路径
    Private localFilePath

    Private Sub Class_Initialize()
        bandwidth=128   '128K,按1M带宽计算的每秒下载量
        BlockSize = bandwidth*1024
        '(可根据自己的带宽设置,带宽除以8),建议不要设的太小
        
        BlockTimeout = 64'应当根据块的大小来设置。这里设为64秒。
        '如果128K的数据64秒还下载不完(按每秒2K保守估算),则超时。
        
        PercentTableWidth = 100 '进度条总宽度
    End Sub
    
    Public Sub Down(url, localPath)
        RemoteFileUrl = url
        localFilePath=localPath
        LocalFileFullPhysicalPath = Server.Mappath(localPath)
        Call go
    End Sub

    Private Sub go
        Dim http, ados
        On Error Resume Next
        Set http = Server.CreateObject("Msxml2.ServerXMLHTTP.7.0")
        If Err Then
            Err.Clear
            Set http = Server.CreateObject("Msxml2.ServerXMLHTTP.6.0")
            If Err Then
                Err.Clear
                Set http = Server.CreateObject("Msxml2.ServerXMLHTTP.5.0")
                If Err Then
                    Err.Clear
                    Set http = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
                    If Err Then
                        Err.Clear
                        Set http = Server.CreateObject("Msxml2.ServerXMLHTTP")
                        If Err Then
                            Err.Clear
                            Response.Write "服务器不支持Msxml,本程序无法运行!"
                            Response.End
                        End If
                    End If
                End If
            End If
        End If
        Set ados = Server.CreateObject("Adodb.Stream")
        Dim RangeStart'分段下载的开始位置
        Dim fso
        Set fso = Server.CreateObject("Scripting.FileSystemObject")
        If fso.FileExists(LocalFileFullPhysicalPath) Then'判断要下载的文件是否已经存在
            RangeStart = fso.GetFile(LocalFileFullPhysicalPath).Size'若存在,以当前文件大小作为开始位置
        Else
            RangeStart = 0'若不存在,一切从零开始
            fso.CreateTextFile(LocalFileFullPhysicalPath).Close'新建文件
        End If

        Set fso = Nothing
        Dim FileDownStart'本次下载的开始位置
        Dim FileDownEnd'本次下载的结束位置
        Dim FileDownBytes'本次下载的字节数
        Dim DownStartTime'开始下载时间
        Dim DownEndTime'完成下载时间
        Dim DownAvgSpeed'平均下载速度
        Dim BlockStartTime'块开始下载时间
        Dim BlockEndTime'块完成下载时间
        Dim BlockAvgSpeed'块平均下载速度
        Dim DownPercent'已下载的百分比
        FileDownStart = RangeStart

        Dim adosCache'数据缓冲区
        Dim adosCacheSize'缓冲区大小
        Set adosCache = Server.CreateObject("Adodb.Stream")

        adosCache.Type = 1'数据流类型设为字节
        adosCache.Mode = 3'数据流访问模式设为读写
        adosCache.Open
        adosCacheSize = 4 * 1024 * 1024'设为4M,
        '获取的数据先放到(内存)缓冲区中,当缓冲区满的时候数据写入磁盘
        '若在自己的电脑上运行本程序,当下载百兆以上级别的大文件的时候,可设置大的缓冲区
        '当然,也不要设的太大,免得发生(按下浏览器上的停止按钮或断电等)
        '意外情况导致缓冲区中的数据没有存盘,那缓冲区中的数据就白下载了

        '先显示html头部
        Dim ResponseRange'服务器返回的http头中的"Content-Range"
        Dim CurrentLastBytes'当前下载的结束位置(即ResponseRange中的上限)
        Dim TotalBytes'文件总字节数
        Dim temp


        '分段下载

        DownStartTime = Now()

        Do

            BlockStartTime = Timer()
            http.Open "GET", RemoteFileUrl, True, "", ""'用异步方式调用serverxmlhttp
            '构造http头

            http.setRequestHeader "Referer", RefererUrl
            http.setRequestHeader "Accept", "*/*"
            http.setRequestHeader "User-Agent", "Baiduspider+(+http://www.baidu.com/search/spider.htm)"'伪装成Baidu
            'http.setRequestHeader "User-Agent","Googlebot/2.1 (+http://www.google.com/bot.html)"'伪装成Google
            http.setRequestHeader "Range", "bytes=" & RangeStart & "-" & CStr(RangeStart + BlockSize - 1)'分段关键
            http.setRequestHeader "Content-Type", "application/octet-stream"
            http.setRequestHeader "Pragma", "no-cache"
            http.setRequestHeader "Cache-Control", "no-cache"
            http.send'发送
            '循环等待数据接收

            While (http.readyState <> 4)

                '判断是否块超时
                temp = Timer() - BlockStartTime

                If (temp > BlockTimeout) Then
                    http.abort
                    Response.Write "<script>s(""status"").innerHTML=""<strong>错误:数据下载超时,建议重试。</strong>"";</script>" & vbNewLine & "</body></html>"
                    Call ErrHandler()
                    Call CloseObject()
                    Response.End
                End If
                http.waitForResponse 1000'等待1000毫秒
            Wend
            '检测状态

            If http.status = 416 Then'服务器不能满足客户在请求中指定的Range头。应当是已下载完毕。
                FileDownEnd = FileDownStart'设置一下FileDownEnd,免得后面的FileDownBytes计算出错
                Call CloseObject()
                Exit Do
            End If

            '检测状态

            If http.status > 299 Then'http出错
                Response.Write "<script>s(""status"").innerHTML=""<strong>http错误:" & http.status & " " & http.statusText & "</strong>"";</script>" & vbNewLine & "</body></html>"
                Call ErrHandler()
                Call CloseObject()
                Response.End

            End If

            '检测状态
            If http.status <> 206 Then'服务器不支持断点续传
                Response.Write "<script>s(""status"").innerHTML=""<strong>错误:服务器不支持断点续传!</strong>"";</script>" & vbNewLine & "</body></html>"
                Call ErrHandler()
                Call CloseObject()
                Response.End
            End If

            '检测缓冲区是否已满
            If adosCache.Size >= adosCacheSize Then
                '打开磁盘上的文件
                ados.Type = 1'数据流类型设为字节
                ados.Mode = 3'数据流访问模式设为读写
                ados.Open
                ados.LoadFromFile LocalFileFullPhysicalPath'打开文件
                ados.Position = ados.Size'设置文件指针初始位置
                '将缓冲区数据写入磁盘文件
                adosCache.Position = 0
                ados.Write adosCache.Read
                ados.SaveToFile LocalFileFullPhysicalPath, 2'覆盖保存
                ados.Close
                '缓冲区复位
                adosCache.Position = 0
                adosCache.SetEOS
            End If

            '保存块数据到缓冲区中
            adosCache.Write http.responseBody'写入数据
            '判断是否全部(块)下载完毕
            ResponseRange = http.getResponseHeader("Content-Range")'获得http头中的"Content-Range"
            If ResponseRange = "" Then'没有它就不知道下载完了没有
                Response.Write "<script>s(""status"").innerHTML=""<strong>错误:文件长度未知!</strong>"";</script>" & vbNewLine & "</body></html>"
                Call CloseObject()
                Response.End
            End If
            temp = Mid(ResponseRange, InStr(ResponseRange, "-") + 1)'Content-Range是类似123-456/789的样子
            CurrentLastBytes = CLng(Left(temp, InStr(temp, "/") -1))'123是开始位置,456是结束位置
            TotalBytes = CLng(Mid(temp, InStr(temp, "/") + 1))'789是文件总字节数

            If TotalBytes - CurrentLastBytes = 1 Then
                FileDownEnd = TotalBytes
                '将缓冲区数据写入磁盘文件

                ados.Type = 1'数据流类型设为字节
                ados.Mode = 3'数据流访问模式设为读写
                ados.Open
                ados.LoadFromFile LocalFileFullPhysicalPath'打开文件
                ados.Position = ados.Size'设置文件指针初始位置
                adosCache.Position = 0
                ados.Write adosCache.Read
                ados.SaveToFile LocalFileFullPhysicalPath, 2'覆盖保存
                ados.Close
                Response.Write "<script>s(""downsize"").innerHTML=""" & BytesToString(TotalBytes) & """;</script>" & vbNewLine
                Response.Flush
                Call CloseObject()
                Exit Do'结束位置比总大小少1就表示传输完成了
            End If

            '调整块开始位置,准备下载下一个块

            RangeStart = RangeStart + BlockSize
            '计算块下载速度、进度条宽度、已下载的百分比
            BlockEndTime = Timer()
            temp = (BlockEndTime - BlockStartTime)
            If temp > 0 Then
                BlockAvgSpeed = Int(BlockSize / 1024 / temp)
            Else
                BlockAvgSpeed = ""
            End If
            percentWidth = Int(PercentTableWidth * RangeStart / TotalBytes)
            DownPercent = Int(100 * RangeStart / TotalBytes)
            '更新进度条
            Response.Write "<script>$('"&DownPercent&"','"&BytesToString(RangeStart)&"','"&BytesToString(TotalBytes)&"','"&BlockAvgSpeed&"');</script>" & vbNewLine
            Response.Flush

        Loop While Response.IsClientConnected
        If Not Response.IsClientConnected Then
            Response.End

        End If



        DownEndTime = Now()
        FileDownBytes = FileDownEnd - FileDownStart
        temp = DateDiff("s", DownStartTime, DownEndTime)
        If (FileDownBytes <> 0) And (temp <> 0) Then
            DownAvgSpeed = Int((FileDownBytes / 1024) / temp)
        Else
            DownAvgSpeed = ""
        End If

        '全部下载完毕后更新进度条
        Response.Write "<script>$('100','"&BytesToString(RangeStart)&"','"&BytesToString(TotalBytes)&"','"&BlockAvgSpeed&"');</script>" & vbNewLine
        Response.Write "<script>s(""status"").innerHTML=""下载完毕!用时:" & S2T(DateDiff("s", DownStartTime, DownEndTime)) & ",平均下载速度:" & DownAvgSpeed & "K/秒<br /><a href="&localFilePath&">"&localFilePath&"</a>"";</script></body></html>" & vbNewLine
    End Sub


    Private Sub CloseObject()
        Set ados = Nothing
        Set http = Nothing
        adosCache.Close
        Set adosCache = Nothing
    End Sub


    'http异常退出处理代码

    Private Sub ErrHandler()
        Dim fso
        Set fso = Server.CreateObject("Scripting.FileSystemObject")
        If fso.FileExists(LocalFileFullPhysicalPath) Then'判断要下载的文件是否已经存在
            If fso.GetFile(LocalFileFullPhysicalPath).Size = 0 Then'若文件大小为0
                fso.DeleteFile LocalFileFullPhysicalPath'删除文件
            End If
        End If
        Set fso = Nothing
    End Sub

    '------------------------------
    '将秒数转换为"x小时y分钟z秒"形式
    '------------------------------

    Private Function S2T(ByVal s)
        Dim x, y, z, t
        If s < 1 Then
            S2T = (s * 1000) & "毫秒"
        Else
            s = Int(s)
            x = Int(s / 3600)
            t = s - 3600 * x
            y = Int(t / 60)
            z = t - 60 * y
            If x > 0 Then
                S2T = x & "小时" & y & "分" & z & "秒"
            Else
                If y > 0 Then
                    S2T = y & "分" & z & "秒"
                Else
                    S2T = z & "秒"
                End If
            End If
        End If
    End Function

    Private Function BytesToString(ByVal iSize)
        Dim sRet, KB, MB, S
        KB = 1024
        MB = KB * KB
        If Not IsNumeric(iSize) Then
            BytesToString = "未知"
            Exit Function
        End If
        If iSize < KB Then
            sRet = iSize & " Bytes"
        Else
            S = iSize / KB
            If S < 10 Then
                sRet = FormatNumber(iSize / KB, 2, -1) & " KB"
            ElseIf S < 100 Then
                sRet = FormatNumber(iSize / KB, 1, -1) & " KB"
            ElseIf S < 1000 Then
                sRet = FormatNumber(iSize / KB, 0, -1) & " KB"
            ElseIf S < 10000 Then
                sRet = FormatNumber(iSize / MB, 2, -1) & " MB"
            ElseIf S < 100000 Then
                sRet = FormatNumber(iSize / MB, 1, -1) & " MB"
            ElseIf S < 1000000 Then
                sRet = FormatNumber(iSize / MB, 0, -1) & " MB"
            ElseIf S < 10000000 Then
                sRet = FormatNumber(iSize / MB / KB, 2, -1) & " GB"
            Else
                sRet = FormatNumber(iSize / MB / KB, 1, -1) & " GB"
            End If
        End If
        BytesToString = sRet
    End Function

End Class
%>
<%
Public Sub HtmlHead(url,localPath)
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>带进度条的ASP无组件断点续传下载</title>
<script type="text/javascript">
var s=function(Me){return document.getElementById(Me);}
function $(a,b,c,d,e){
    s("percentBGcolor").style.width=a+"%";
    s("downpercent").innerHTML=a+"%";
    s("downsize").innerHTML=b;
    s("totalbytes").innerHTML=c;
    s("blockavgspeed").innerHTML=d;
}
</script>
<style>
body{text-align:center;}
.progress{
    margin:0 auto;
    padding:0x;
    height:20px;
    width:500px;
    }
#percent{
    border:1px solid #6AB7D1;
    background:#eee;
    height:100%;
    width:100%;
    overflow:hidden;
    margin-bottom:-20px;
    }
#percent span{
    float:left;
    margin:0px;
    padding:0px;
    margin-top:1px;
    height:100%;
    width:0%;
    background:#E0CFF1;
    margin-bottom:-20px;
    }
.text{
    float:left;
    margin:0px;
    padding:0px;
    width:100%;
    height:100%;
    text-align:center;
    font-size:12px;
    line-height:20px;
    }
.form1{width:500px;margin:0 auto;font-size:12px;}
.form1 input{border:1px solid #B0CFF0;font-size:12px;margin-top:5px;}
.input{width:430px;}
</style>
</head>
<body>
<div class="progress">
    <div id="percent"><span id="percentBGcolor"></span></div>
    <div class="text">
        已完成:<span id="downpercent" style="color:green">0%</span> 
        <span id="downsize" style="color:red">0</span> / 
        <span id="totalbytes" style="color:blue">0</span> 字节(<span id="blockavgspeed">0</span>K/秒)
    </div>
</div>
<div style="font-size:13px;margin-top:10px;" id="status"></div>


<form action="" method="post" class="form1">
    下载地址:<input class="input" type="text" name="url" value="<%=url%>" /><br />
    保存路径:<input class="input" type="text" name="localPath" value="<%=localPath%>" /><br />
     <input style="float:right;margin:10px 10px 0 0;" type="submit" value="提交" name="submit"/>
</form>
<%End Sub%>


<%
Dim sURL,sLocalPath
sURL=request.form("url")
sLocalPath=request.form("localPath")
Call HtmlHead(sURL,sLocalPath)
If sURL<>"" and sLocalPath<>"" then
    Dim s
    set s=New Download
'   s.RefererUrl="http://www.newxing.com/" '设置来路
    Call s.down(sURL,sLocalPath)
    set s=Nothing
end if
%>


文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags:
相关日志:
评论: 0 | 引用: 0 | 查看次数: -
发表评论
昵 称:
密 码: 游客发言不需要密码.
内 容:
验证码: 验证码
选 项:
虽然发表评论不用注册,但是为了保护您的发言权,建议您注册帐号.