<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%><%Option Explicit%>
<%'==================================''带进度条的ASP无组件断点续传下载''=================================='简介：'1)利用xmlhttp方式'2)无组件'3)异步方式获取，节省服务器资源'4)服务器到服务器的文件传送。(当然，你自己电脑上的IIS也是http服务器)'5)支持断点续传'6)分段下载'7)使用缓冲区，提升下载速度'8)支持大文件下载(速度我就不说了，你可以测，用事实说话)'9)带进度条：下载百分比、下载量、即时下载速度、平均下载速度''用法：'设置好下面的三个变量，RemoteFileUrl、LocalFileUrl、RefererUrl''作者：午夜狂龙(Madpolice)'
[email protected]'2005.12.25'===============================%>
<%'------------为设置部分------<%Server.Scripttimeout = 24 * 60 * 60'脚本超时设置，这里设为24小时%><%Dim RemoteFileUrl'远程文件路径Dim LocalFileUrl'本地文件路径,相对路径，可以包含/及..
RemoteFileUrl = "http://202.102.14.137/win98.zip"LocalFileUrl = "win98.zip"
Dim RefererUrl'该属性设置文件下载的引用页，'某些网站只允许通过他们网站内的连接下载文件，'这些网站的服务器判断用户是否是在他们网站内点击的文件链接就是靠这个属性。RefererUrl = "http://www.skycn.com/crack_skycn.html"'若远程服务器未限制，可留空
Dim BlockSize'分段下载的块大小Dim BlockTimeout'下载块的超时时间(秒)
BlockSize = 128 * 1024'128K，按1M带宽计算的每秒下载量（可根据自己的带宽设置，带宽除以8），建议不要设的太小BlockTimeout = 64'应当根据块的大小来设置。这里设为64秒。如果128K的数据64秒还下载不完(按每秒2K保守估算)，则超时。
Dim PercentTableWidth'进度条总宽度
PercentTableWidth = 560%><%'--------------------以上为设置部分---------------%>
<%'***********************************'！！！以下内容无须修改！！！'***********************************%><%Dim LocalFileFullPhysicalPath'本地文件在硬盘上的绝对路径
LocalFileFullPhysicalPath = Server.Mappath(LocalFileUrl)%>
<%Dim http,ados
On Error Resume NextSet http = Server.CreateObject("Msxml2.ServerXMLHTTP.7.0")If Err ThenErr.Clear
Set http = Server.CreateObject("Msxml2.ServerXMLHTTP.6.0")If Err ThenErr.Clear
Set http = Server.CreateObject("Msxml2.ServerXMLHTTP.5.0")If Err ThenErr.Clear
Set http = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")If Err ThenErr.Clear
Set http = Server.CreateObject("Msxml2.ServerXMLHTTP")If Err ThenErr.ClearResponse.Write "服务器不支持Msxml，本程序无法运行！"Response.EndEnd IfEnd IfEnd IfEnd IfEnd IfOn Error Goto 0
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'若存在，以当前文件大小作为开始位置ElseRangeStart = 0'若不存在，一切从零开始fso.CreateTextFile(LocalFileFullPhysicalPath).Close'新建文件End IfSet fso = Nothing%>
<%Dim FileDownStart'本次下载的开始位置Dim FileDownEnd'本次下载的结束位置Dim FileDownBytes'本次下载的字节数Dim DownStartTime'开始下载时间Dim DownEndTime'完成下载时间Dim DownAvgSpeed'平均下载速度
Dim BlockStartTime'块开始下载时间Dim BlockEndTime'块完成下载时间Dim BlockAvgSpeed'块平均下载速度
Dim percentWidth'进度条的宽度Dim DownPercent'已下载的百分比
FileDownStart = RangeStart%>
<%Dim adosCache'数据缓冲区Dim adosCacheSize'缓冲区大小
Set adosCache = Server.CreateObject("Adodb.Stream")adosCache.Type = 1'数据流类型设为字节adosCache.Mode = 3'数据流访问模式设为读写adosCache.OpenadosCacheSize = 4 * 1024 * 1024'设为4M，获取的数据先放到(内存)缓冲区中，当缓冲区满的时候数据写入磁盘
'若在自己的电脑上运行本程序，当下载百兆以上级别的大文件的时候，可设置大的缓冲区'当然，也不要设的太大，免得发生(按下浏览器上的停止按钮或断电等)意外情况导致缓冲区中的数据没有存盘，那缓冲区中的数据就白下载了%>
<%'先显示html头部Response.ClearCall HtmlHead()Response.Flush%>
<%Dim ResponseRange'服务器返回的http头中的"Content-Range"Dim CurrentLastBytes'当前下载的结束位置(即ResponseRange中的上限)Dim TotalBytes'文件总字节数Dim temp
'分段下载DownStartTime = Now()
DoBlockStartTime = Timer()
http.open "GET",RemoteFileUrl,true,"",""'用异步方式调用serverxmlhttp
'构造http头http.setRequestHeader "Referer",RefererUrlhttp.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)"'伪装成Googlehttp.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() - BlockStartTimeIf (temp > BlockTimeout) Thenhttp.abortResponse.Write "<script>document.getElementById(""status"").innerHTML=""<strong>错误：数据下载超时，建议重试。</strong>"";</script>" & vbNewLine & "</body></html>"Call ErrHandler()Call CloseObject()Response.EndEnd If
http.waitForResponse 1000'等待1000毫秒Wend
'检测状态If http.status = 416 Then'服务器不能满足客户在请求中指定的Range头。应当是已下载完毕。FileDownEnd = FileDownStart'设置一下FileDownEnd，免得后面的FileDownBytes计算出错Call CloseObject()Exit DoEnd If
'检测状态If http.status > 299 Then'http出错Response.Write "<script>document.getElementById(""status"").innerHTML=""<strong>http错误：" & http.status & " " & http.statusText & "</strong>"";</script>" & vbNewLine & "</body></html>"Call ErrHandler()Call CloseObject()Response.EndEnd If
'检测状态If http.status <> 206 Then'服务器不支持断点续传Response.Write "<script>document.getElementById(""status"").innerHTML=""<strong>错误：服务器不支持断点续传！</strong>"";</script>" & vbNewLine & "</body></html>"Call ErrHandler()Call CloseObject()Response.EndEnd If
'检测缓冲区是否已满If adosCache.Size >= adosCacheSize Then'打开磁盘上的文件ados.Type = 1'数据流类型设为字节ados.Mode = 3'数据流访问模式设为读写ados.Openados.LoadFromFile LocalFileFullPhysicalPath'打开文件ados.Position = ados.Size'设置文件指针初始位置
'将缓冲区数据写入磁盘文件adosCache.Position = 0ados.Write adosCache.Readados.SaveToFile LocalFileFullPhysicalPath,2'覆盖保存ados.Close
'缓冲区复位adosCache.Position = 0adosCache.SetEOSEnd If'保存块数据到缓冲区中adosCache.Write http.responseBody'写入数据
'判断是否全部(块)下载完毕ResponseRange = http.getResponseHeader("Content-Range")'获得http头中的"Content-Range"If ResponseRange = "" Then'没有它就不知道下载完了没有Response.Write "<script>document.getElementById(""status"").innerHTML=""<strong>错误：文件长度未知！</strong>"";</script>" & vbNewLine & "</body></html>"Call CloseObject()Response.EndEnd Iftemp = 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 ThenFileDownEnd = TotalBytes
'将缓冲区数据写入磁盘文件ados.Type = 1'数据流类型设为字节ados.Mode = 3'数据流访问模式设为读写ados.Openados.LoadFromFile LocalFileFullPhysicalPath'打开文件ados.Position = ados.Size'设置文件指针初始位置adosCache.Position = 0ados.Write adosCache.Readados.SaveToFile LocalFileFullPhysicalPath,2'覆盖保存ados.Close
Response.Write "<script>document.getElementById(""downsize"").innerHTML=""" & TotalBytes & """;</script>" & vbNewLineResponse.FlushCall CloseObject()Exit Do'结束位置比总大小少1就表示传输完成了End If'调整块开始位置，准备下载下一个块RangeStart = RangeStart + BlockSize
'计算块下载速度、进度条宽度、已下载的百分比BlockEndTime = Timer()temp = (BlockEndTime - BlockStartTime)If temp > 0 ThenBlockAvgSpeed = Int(BlockSize / 1024 / temp)ElseBlockAvgSpeed = ""End IfpercentWidth = Int(PercentTableWidth * RangeStart / TotalBytes)DownPercent = Int(100 * RangeStart / TotalBytes)
'更新进度条Response.Write "<script>document.getElementById(""downpercent"").innerHTML=""" & DownPercent & "%"";document.getElementById(""downsize"").innerHTML=""" & RangeStart & """;document.getElementById(""totalbytes"").innerHTML=""" & TotalBytes & """;document.getElementById(""blockavgspeed"").innerHTML=""" & BlockAvgSpeed & """;document.getElementById(""percentdone"").style.width=""" & percentWidth & """;</script>" & vbNewLineResponse.FlushLoop While Response.IsClientConnected
If Not Response.IsClientConnected ThenResponse.EndEnd If
DownEndTime = Now()FileDownBytes = FileDownEnd - FileDownStarttemp = DateDiff("s",DownStartTime,DownEndTime)If (FileDownBytes <> 0) And (temp <> 0) ThenDownAvgSpeed = Int((FileDownBytes / 1024) / temp)ElseDownAvgSpeed = ""End If
'全部下载完毕后更新进度条Response.Write "<script>document.getElementById(""downpercent"").innerHTML=""100%"";document.getElementById(""percentdone"").style.width=""" & PercentTableWidth & """;document.getElementById(""percent"").style.display=""none"";document.getElementById(""status"").innerHTML=""<strong>下载完毕！用时：" & S2T(DateDiff("s",DownStartTime,DownEndTime)) & "，平均下载速度：" & DownAvgSpeed & "K/秒</strong>"";</script>" & vbNewLine%>
</body></html>
<%Sub CloseObject()Set ados = NothingSet http = NothingadosCache.CloseSet adosCache = NothingEnd Sub%>
<%'http异常退出处理代码Sub ErrHandler()Dim fso
Set fso = Server.CreateObject("Scripting.FileSystemObject")If fso.FileExists(LocalFileFullPhysicalPath) Then'判断要下载的文件是否已经存在If fso.GetFile(LocalFileFullPhysicalPath).Size = 0 Then'若文件大小为0fso.DeleteFile LocalFileFullPhysicalPath'删除文件End IfEnd IfSet fso = NothingEnd Sub%>
<%Sub HtmlHead()%><html><head><meta http-equiv="Content-Type" content="text/html; charset=gb2312"><title>带进度条的ASP无组件断点续传下载----作者：午夜狂龙(Madpolice)--2005.12.25</title></head><body><div id="status">正在下载 <span style="color:blue"><%=RemoteFileUrl%></span> ,请稍候...</div><div> </div><div id="progress">已完成：<span id="downpercent" style="color:green"></span> <span id="downsize" style="color:red"><%=RangeStart%></span> / <span id="totalbytes" style="color:blue"></span> 字节(<span id="blockavgspeed"></span>K/秒)</div><div> </div><div id="percent" align="center" style="display:''"><table style="border-collapse:collapse;" border="1" bordercolor="#666666" cellpadding="0" cellspacing="0" width="<%=PercentTableWidth%>" align="center" bgcolor="#eeeeee"><tr height="20"><td><table border="0" width="" cellspacing="1" bgcolor="#0033FF" id="percentdone"><tr><td> <td></tr></table></td></tr></table></div><%End Sub%>
<%'------------------------------'将秒数转换为"x小时y分钟z秒"形式'------------------------------Function S2T(ByVal s)Dim x,y,z,tIf s < 1 ThenS2T = (s * 1000) & "毫秒"Elses = Int(s)x = Int(s / 3600)t = s - 3600 * xy = Int(t / 60)z = t - 60 * yIf x > 0 ThenS2T = x & "小时" & y & "分" & z & "秒"ElseIf y > 0 ThenS2T = y & "分" & z & "秒"ElseS2T = z & "秒"End IfEnd IfEnd IfEnd Function'-----------------------%>
