<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>

<%Option Explicit%>                                                
<%

'==================================

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

''==================================

'简介：

'1)利用xmlhttp方式

'2)无组件

'3)异步方式获取，节省服务器资源

'4)服务器到服务器的文件传送。(当然，你自己电脑上的IIS也是http服务器)

'5)支持断点续传

'6)分段下载

'7)使用缓冲区，提升下载速度

'8)支持大文件下载(速度我就不说了，你可以测，用事实说话)

'9)带进度条：下载百分比、下载量、即时下载速度、平均下载速度

'

'用法：

'设置好下面的三个变量，RemoteFileUrl、LocalFileUrl、RefererUrl

'

'作者：午夜狂龙(Madpolice)

'madpolice_dong@163.com

'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 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

On 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'若存在，以当前文件大小作为开始位置

Else

RangeStart = 0'若不存在，一切从零开始

fso.CreateTextFile(LocalFileFullPhysicalPath).Close'新建文件

End If

Set fso =