技术 - ASP/.Net - 带进度条的ASP无组件断点续传下载

25
08 Jul.

带进度条的ASP无组件断点续传下载

最后更新: 2009/02/28  |  评论: 0  |  关键词: 断点  进度条  无组件  下载  续传  

  1. 利用xmlhttp方式
  2. 无组件
  3. 异步方式获取,节省服务器资源
  4. 服务器到服务器的文件传送。(当然,你自己电脑上的IIS也是http服务器)
  5. 支持断点续传
  6. 分段下载
  7. 使用缓冲区,提升下载速度
  8. 支持大文件下载(速度我就不说了,你可以测,用事实说话)
  9. 带进度条:下载百分比、下载量、即时下载速度、平均下载速度
  1. <%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>  
  2. <%Option Explicit%>  
  3. <%  
  4. '================================================================  
  5. '  
  6. '        带进度条的ASP无组件断点续传下载  
  7. '  
  8. '================================================================  
  9. '简介:  
  10. '    1)利用xmlhttp方式  
  11. '    2)无组件  
  12. '    3)异步方式获取,节省服务器资源  
  13. '    4)服务器到服务器的文件传送。(当然,你自己电脑上的IIS也是http服务器)  
  14. '    5)支持断点续传  
  15. '    6)分段下载  
  16. '    7)使用缓冲区,提升下载速度  
  17. '    8)支持大文件下载(速度我就不说了,你可以测,用事实说话)  
  18. '    9)带进度条:下载百分比、下载量、即时下载速度、平均下载速度  
  19. '  
  20. '用法:  
  21. '    设置好下面的三个变量,RemoteFileUrl、LocalFileUrl、RefererUrl  
  22. '  
  23. '作者:午夜狂龙(Madpolice)  
  24. 'madpolice_dong@163.com  
  25. '2005.12.25  
  26. '================================================================  
  27. %>  
  28.  
  29.  
  30. <%'-----------------------------以下为设置部分--------------------------------%>  
  31. <%Server.Scripttimeout = 24 * 60 * 60    '脚本超时设置,这里设为24小时%>  
  32. <%  
  33. Dim RemoteFileUrl    '远程文件路径  
  34. Dim LocalFileUrl    '本地文件路径,相对路径,可以包含/及..  
  35.  
  36.  
  37. RemoteFileUrl = "http://ftp.chinalinuxpub.com/redhat/ISO/4AS/RHEL4-i386-AS-disc1.iso" 
  38. LocalFileUrl = "RHEL4-i386-AS-disc1.iso" 
  39. Dim RefererUrl  
  40. '该属性设置文件下载的引用页,  
  41. '某些网站只允许通过他们网站内的连接下载文件,  
  42. '这些网站的服务器判断用户是否是在他们网站内点击的文件链接就是靠这个属性。  
  43. RefererUrl = "http://ftp.chinalinuxpub.com/redhat/ISO/4AS/RHEL4-i386-AS-disc1.iso"    '若远程服务器未限制,可留空  
  44. Dim BlockSize    '分段下载的块大小  
  45. Dim BlockTimeout    '下载块的超时时间(秒)  
  46.  
  47.  
  48. BlockSize = 128 * 1024    '128K,按1M带宽计算的每秒下载量(可根据自己的带宽设置,带宽除以8),建议不要设的太小  
  49. BlockTimeout = 64    '应当根据块的大小来设置。这里设为64秒。如果128K的数据64秒还下载不完(按每秒2K保守估算),则超时。  
  50.  
  51.  
  52.  
  53. Dim PercentTableWidth    '进度条总宽度  
  54.  
  55.  
  56. PercentTableWidth = 560  
  57. %>  
  58. <%'-----------------------------以上为设置部分--------------------------------%>  
  59.  
  60.  
  61. <%  
  62. '***********************************************************************  
  63. '        !!!以下内容无须修改!!!  
  64. '***********************************************************************  
  65. %>  
  66. <%  
  67. Dim LocalFileFullPhysicalPath    '本地文件在硬盘上的绝对路径  
  68.  
  69.  
  70. LocalFileFullPhysicalPath = Server.Mappath(LocalFileUrl)  
  71. %>  
  72.  
  73.  
  74. <%  
  75. Dim http,ados  
  76.  
  77.  
  78. On Error Resume Next 
  79. Set http = Server.CreateObject("Msxml2.ServerXMLHTTP.7.0")  
  80. If Err Then 
  81.     Err.Clear  
  82.  
  83.  
  84.     Set http = Server.CreateObject("Msxml2.ServerXMLHTTP.6.0")  
  85.     If Err Then 
  86.     Err.Clear  
  87.  
  88.  
  89.     Set http = Server.CreateObject("Msxml2.ServerXMLHTTP.5.0")  
  90.     If Err Then 
  91.     Err.Clear  
  92.  
  93.  
  94.     Set http = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")  
  95.     If Err Then 
  96.         Err.Clear  
  97.  
  98.  
  99.         Set http = Server.CreateObject("Msxml2.ServerXMLHTTP")  
  100.         If Err Then 
  101.         Err.Clear  
  102.         Response.Write "服务器不支持Msxml,本程序无法运行!" 
  103.         Response.End 
  104.         End If 
  105.     End If 
  106.     End If 
  107.     End If 
  108. End If 
  109. On Error Goto 0  
  110.  
  111.  
  112. Set ados = Server.CreateObject("Adodb.Stream")  
  113. %>  
  114.  
  115.  
  116. <%  
  117. Dim RangeStart    '分段下载的开始位置  
  118. Dim fso  
  119.  
  120.  
  121. Set fso = Server.CreateObject("Scripting.FileSystemObject")  
  122. If fso.FileExists(LocalFileFullPhysicalPath) Then    '判断要下载的文件是否已经存在  
  123.      RangeStart = fso.GetFile(LocalFileFullPhysicalPath).Size    '若存在,以当前文件大小作为开始位置  
  124. Else 
  125.      RangeStart = 0    '若不存在,一切从零开始  
  126.      fso.CreateTextFile(LocalFileFullPhysicalPath).Close    '新建文件  
  127. End If 
  128. Set fso = Nothing 
  129. %>  
  130.  
  131.  
  132. <%  
  133. Dim FileDownStart    '本次下载的开始位置  
  134. Dim FileDownEnd    '本次下载的结束位置  
  135. Dim FileDownBytes    '本次下载的字节数  
  136. Dim DownStartTime    '开始下载时间  
  137. Dim DownEndTime    '完成下载时间  
  138. Dim DownAvgSpeed    '平均下载速度  
  139.  
  140.  
  141. Dim BlockStartTime    '块开始下载时间  
  142. Dim BlockEndTime    '块完成下载时间  
  143. Dim BlockAvgSpeed    '块平均下载速度  
  144.  
  145.  
  146. Dim percentWidth    '进度条的宽度  
  147. Dim DownPercent    '已下载的百分比  
  148.  
  149.  
  150. FileDownStart = RangeStart  
  151. %>  
  152.  
  153.  
  154. <%  
  155. Dim adosCache    '数据缓冲区  
  156. Dim adosCacheSize    '缓冲区大小  
  157.  
  158.  
  159. Set adosCache = Server.CreateObject("Adodb.Stream")  
  160. adosCache.Type = 1    '数据流类型设为字节  
  161. adosCache.Mode = 3    '数据流访问模式设为读写  
  162. adosCache.Open  
  163. adosCacheSize = 4 * 1024 * 1024    '设为4M,获取的数据先放到(内存)缓冲区中,当缓冲区满的时候数据写入磁盘  
  164.  
  165.  
  166. '若在自己的电脑上运行本程序,当下载百兆以上级别的大文件的时候,可设置大的缓冲区  
  167. '当然,也不要设的太大,免得发生(按下浏览器上的停止按钮或断电等)意外情况导致缓冲区中的数据没有存盘,那缓冲区中的数据就白下载了  
  168. %>  
  169.  
  170.  
  171. <%  
  172. '先显示html头部  
  173. Response.Clear  
  174. Call HtmlHead()  
  175. Response.Flush  
  176. %>  
  177.  
  178.  
  179. <%  
  180. Dim ResponseRange    '服务器返回的http头中的"Content-Range"  
  181. Dim CurrentLastBytes    '当前下载的结束位置(即ResponseRange中的上限)  
  182. Dim TotalBytes    '文件总字节数  
  183. Dim temp  
  184.  
  185.  
  186. '分段下载  
  187. DownStartTime = Now()  
  188.  
  189.  
  190. Do 
  191.     BlockStartTime = Timer()  
  192.  
  193.  
  194.     http.open "GET",RemoteFileUrl,true,"",""    '用异步方式调用serverxmlhttp  
  195.  
  196.  
  197.     '构造http头  
  198.     http.setRequestHeader "Referer",RefererUrl  
  199.     http.setRequestHeader "Accept","*/*" 
  200.     http.setRequestHeader "User-Agent","Baiduspider+(+http://www.baidu.com/search/spider.htm)"    '伪装成Baidu  
  201.     'http.setRequestHeader "User-Agent","Googlebot/2.1 (+http://www.google.com/bot.html)"    '伪装成Google  
  202.     http.setRequestHeader "Range","bytes=" & RangeStart & "-" & Cstr(RangeStart + BlockSize - 1)    '分段关键  
  203.     http.setRequestHeader "Content-Type","application/octet-stream" 
  204.     http.setRequestHeader "Pragma","no-cache" 
  205.     http.setRequestHeader "Cache-Control","no-cache" 
  206.  
  207.  
  208.     http.send    '发送  
  209.  
  210.  
  211.     '循环等待数据接收  
  212.     While (http.readyState <> 4)  
  213.     '判断是否块超时  
  214.     temp = Timer() - BlockStartTime  
  215.     If (temp > BlockTimeout) Then 
  216.     http.abort  
  217.     Response.Write "<script>document.getElementById(""status"").innerHTML=""<strong>错误:数据下载超时,建议重试。</strong>"";</script>" & vbNewLine & "</body></html>" 
  218.     Call ErrHandler()  
  219.     Call CloseObject()  
  220.     Response.End 
  221.     End If 
  222.  
  223.  
  224.     http.waitForResponse 1000    '等待1000毫秒  
  225.     Wend  
  226.  
  227.  
  228.     '检测状态  
  229.     If http.status = 416 Then    '服务器不能满足客户在请求中指定的Range头。应当是已下载完毕。  
  230.     FileDownEnd = FileDownStart    '设置一下FileDownEnd,免得后面的FileDownBytes计算出错  
  231.     Call CloseObject()  
  232.     Exit Do 
  233.     End If 
  234.  
  235.  
  236.     '检测状态  
  237.     If http.status > 299 Then    'http出错  
  238.     Response.Write "<script>document.getElementById(""status"").innerHTML=""<strong>http错误:" & http.status & "&nbsp;" & http.statusText & "</strong>"";</script>" & vbNewLine & "</body></html>" 
  239.     Call ErrHandler()  
  240.     Call CloseObject()  
  241.     Response.End 
  242.     End If 
  243.  
  244.  
  245.     '检测状态  
  246.     If http.status <> 206 Then    '服务器不支持断点续传  
  247.     Response.Write "<script>document.getElementById(""status"").innerHTML=""<strong>错误:服务器不支持断点续传!</strong>"";</script>" & vbNewLine & "</body></html>" 
  248.     Call ErrHandler()  
  249.     Call CloseObject()  
  250.     Response.End 
  251.     End If 
  252.  
  253.  
  254.     '检测缓冲区是否已满  
  255.     If adosCache.Size >= adosCacheSize Then 
  256.     '打开磁盘上的文件  
  257.     ados.Type = 1    '数据流类型设为字节  
  258.     ados.Mode = 3    '数据流访问模式设为读写  
  259.     ados.Open  
  260.     ados.LoadFromFile LocalFileFullPhysicalPath    '打开文件  
  261.     ados.Position = ados.Size    '设置文件指针初始位置  
  262.  
  263.  
  264.     '将缓冲区数据写入磁盘文件  
  265.     adosCache.Position = 0  
  266.     ados.Write adosCache.Read  
  267.     ados.SaveToFile LocalFileFullPhysicalPath,2    '覆盖保存  
  268.     ados.Close  
  269.  
  270.  
  271.     '缓冲区复位  
  272.     adosCache.Position = 0  
  273.     adosCache.SetEOS  
  274.     End If 
  275.  
  276.     '保存块数据到缓冲区中  
  277.     adosCache.Write http.responseBody    '写入数据  
  278.  
  279.  
  280.     '判断是否全部(块)下载完毕  
  281.     ResponseRange = http.getResponseHeader("Content-Range")    '获得http头中的"Content-Range"  
  282.     If ResponseRange = "" Then    '没有它就不知道下载完了没有  
  283.     Response.Write "<script>document.getElementById(""status"").innerHTML=""<strong>错误:文件长度未知!</strong>"";</script>" & vbNewLine & "</body></html>" 
  284.     Call CloseObject()  
  285.     Response.End 
  286.     End If 
  287.     temp = Mid(ResponseRange,Instr(ResponseRange,"-")+1)    'Content-Range是类似123-456/789的样子  
  288.     CurrentLastBytes = Clng(Left(temp,Instr(temp,"/")-1))    '123是开始位置,456是结束位置  
  289.     TotalBytes = Clng(Mid(temp,Instr(temp,"/")+1))    '789是文件总字节数  
  290.     If TotalBytes - CurrentLastBytes = 1 Then 
  291.     FileDownEnd = TotalBytes  
  292.  
  293.  
  294.     '将缓冲区数据写入磁盘文件  
  295.     ados.Type = 1    '数据流类型设为字节  
  296.     ados.Mode = 3    '数据流访问模式设为读写  
  297.     ados.Open  
  298.     ados.LoadFromFile LocalFileFullPhysicalPath    '打开文件  
  299.     ados.Position = ados.Size    '设置文件指针初始位置  
  300.     adosCache.Position = 0  
  301.     ados.Write adosCache.Read  
  302.     ados.SaveToFile LocalFileFullPhysicalPath,2    '覆盖保存  
  303.     ados.Close  
  304.  
  305.  
  306.     Response.Write "<script>document.getElementById(""downsize"").innerHTML=""" & TotalBytes & """;</script>" & vbNewLine  
  307.     Response.Flush  
  308.     Call CloseObject()  
  309.     Exit Do    '结束位置比总大小少1就表示传输完成了  
  310.     End If 
  311.  
  312.     '调整块开始位置,准备下载下一个块  
  313.     RangeStart = RangeStart + BlockSize  
  314.  
  315.  
  316.     '计算块下载速度、进度条宽度、已下载的百分比  
  317.     BlockEndTime = Timer()  
  318.     temp = (BlockEndTime - BlockStartTime)  
  319.     If temp > 0 Then 
  320.     BlockAvgSpeed = Int(BlockSize / 1024 / temp)  
  321.     Else 
  322.     BlockAvgSpeed = "" 
  323.     End If 
  324.     percentWidth = Int(PercentTableWidth * RangeStart / TotalBytes)  
  325.     DownPercent = Int(100 * RangeStart / TotalBytes)  
  326.  
  327.  
  328.     '更新进度条  
  329.     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>" & vbNewLine  
  330.     Response.Flush  
  331. Loop While Response.IsClientConnected  
  332.  
  333.  
  334. If Not Response.IsClientConnected Then 
  335.     Response.End 
  336. End If 
  337.  
  338.  
  339. DownEndTime = Now()  
  340. FileDownBytes = FileDownEnd - FileDownStart  
  341. temp = DateDiff("s",DownStartTime,DownEndTime)  
  342. If (FileDownBytes <> 0) And (temp <> 0) Then 
  343.     DownAvgSpeed = Int((FileDownBytes / 1024) / temp)  
  344. Else 
  345.     DownAvgSpeed = "" 
  346. End If 
  347.  
  348.  
  349. '全部下载完毕后更新进度条  
  350. 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  
  351. %>  
  352.  
  353.  
  354. </body>  
  355. </html>  
  356.  
  357.  
  358. <%  
  359. Sub CloseObject()  
  360.     Set ados = Nothing 
  361.     Set http = Nothing 
  362.     adosCache.Close  
  363.     Set adosCache = Nothing 
  364. End Sub 
  365. %>  
  366.  
  367.  
  368. <%  
  369. 'http异常退出处理代码  
  370. Sub ErrHandler()  
  371.     Dim fso  
  372.  
  373.  
  374.     Set fso = Server.CreateObject("Scripting.FileSystemObject")  
  375.     If fso.FileExists(LocalFileFullPhysicalPath) Then    '判断要下载的文件是否已经存在  
  376.     If fso.GetFile(LocalFileFullPhysicalPath).Size = 0 Then    '若文件大小为0  
  377.     fso.DeleteFile LocalFileFullPhysicalPath    '删除文件  
  378.     End If 
  379.     End If 
  380.     Set fso = Nothing 
  381. End Sub 
  382. %>  
  383.  
  384.  
  385. <%Sub HtmlHead()%>  
  386. <html>  
  387. <head>  
  388. <meta http-equiv="Content-Type" content="text/html; charset=gb2312">  
  389. <title>带进度条的ASP无组件断点续传下载----作者:午夜狂龙(Madpolice)--2005.12.25</title>  
  390. </head>  
  391. <body>  
  392. <div id="status">正在下载&nbsp;<span style="color:blue"><%=RemoteFileUrl%></span>&nbsp;,请稍候...</div>  
  393. <div>&nbsp;</div>  
  394. <div id="progress">已完成:<span id="downpercent" style="color:green"></span>&nbsp;<span id="downsize" style="color:red"><%=RangeStart%></span>&nbsp;/&nbsp;<span id="totalbytes" style="color:blue"></span>&nbsp;字节(<span id="blockavgspeed"></span>K/秒)</div>  
  395. <div>&nbsp;</div>  
  396. <div id="percent" align="center" style="display:''">  
  397.     <table style="border-collapse:collapse;" border="1" bordercolor="#666666" cellpadding="0" cellspacing="0" width="<%=PercentTableWidth%>" align="center" bgcolor="#eeeeee">  
  398.     <tr height="20">  
  399.     <td>  
  400.         <table border="0" width="" cellspacing="1" bgcolor="#0033FF" id="percentdone">  
  401.         <tr>  
  402.         <td>&nbsp;<td>  
  403.         </tr>  
  404.         </table>  
  405.     </td>  
  406.     </tr>  
  407.     </table>  
  408. </div>  
  409. <%End Sub%>  
  410.  
  411.  
  412. <%  
  413. '--------------------------------------------------------------------  
  414. '将秒数转换为"x小时y分钟z秒"形式  
  415. '--------------------------------------------------------------------  
  416. Function S2T(ByVal s)  
  417.     Dim x,y,z,t  
  418.     If s < 1 Then 
  419.     S2T = (s * 1000) & "毫秒" 
  420.     Else 
  421.     s = Int(s)  
  422.     x = Int(s / 3600)  
  423.     t = s - 3600 * x  
  424.     y = Int(t / 60)  
  425.     z = t - 60 * y  
  426.     If x > 0 Then 
  427.     S2T = x & "小时" & y & "分" & z & "秒" 
  428.     Else 
  429.     If y > 0 Then 
  430.         S2T = y & "分" & z & "秒" 
  431.     Else 
  432.         S2T = z & "秒" 
  433.     End If 
  434.     End If 
  435.     End If 
  436. End Function 
  437. '--------------------------------------------------------------------  
  438. %> 

· 本文由 木炭 发布在《激情燃烧的木炭》 上,原文地址为:http://www.woodcoal.cn/technology/asp/2008725-15330-509.html(转载请保留本信息、全文内容和链接)

发表评论

已经有 0 位朋友发表了对《带进度条的ASP无组件断点续传下载》的看法
 
登录名:  密码:   登录  注册
评论: 
User:
Contact:
验证码:  
  [Ctrl+Enter]

关于本文