ASP实现断点续传

<%
url="http://127.0.0.1/test/20051117173156951.swf"                                      '测试用的地址
if url="" then die("URL不能为空.")                      '敢唬我，空url可不行'
t=instrrev(url,"/")                                        '获得最后一个"/"的位置'
if t=0 or t=len(url) then die("得不到文件名.")    '没有"/"或以"/"结尾'
filename=right(url,len(url)-t)                              '获得要保存的文件名'
if not left(url,7)="http://" then url="http://"&url            '如果粗心把“http://”忘了，加上'
filename=server.mappath(filename)
set fso=server.createobject("Scripting.FileSystemObject")    'FSO，ASO，HTTP三个对象一个都不能少'
set aso=server.createobject("ADODB.Stream")
set http=server.createobject("Microsoft.XMLHTTP")

if fso.fileexists(filename) then                              '判断要下载的文件是否已经存在'
  start=fso.getfile(filename).size                            '存在，以当前文件大小作为开始位置'
else
  start=0                                                    '不存在，一切从零开始'
  fso.createtextfile(filename).close                          '新建文件'
end if

response.write "Connectting..."
response.flush                          '好戏刚刚开始'
current=start                                                  '当前位置即开始位置
do
  http.open "GET",url,false                              '这里用同步方式调用HTTP，本来想用异步方式，一直没有成功
  http.setrequestheader "Range","bytes="&start&"-"&cstr(start+20480) '断点续传的奥秘就在这里
  http.setrequestheader "Content-Type:","application/octet-stream"
  http.send                                                '构造完数据包就开始发送'
  for i=1 to 60                                              '循环等待'
      if http.readystate=3 then showplan()                    '状态3表示开始接收数据，显示进度'
      if http.readystate=4 then exit for                      '状态4表示数据接受完成'
      sleep(1)                                                          ‘这里延时，着正方法不是很好。
  next
  if not http.readystate=4 then die("超时.")              '1分钟还没下完20k？超时！'
  if http.status>299 then die("出错: "&http.status&" "&http.statustext) '不是吧，又出错？'
  if not http.status=206 then die("服务器不支持断点续传.") '服务器不支持断点续传'

  aso.type=1                                                  '数据流类型设为字节'
  aso.open
  aso.loadfromfile filename                                  '打开文件'
  aso.position=start                                          '设置文件指针初始位置'
  aso.write http.responsebody                                '写入数据'
  aso.savetofile filename,2                                  '覆盖保存'
  aso.close

  range=http.getresponseheader("Content-Range")              '获得http头中的"Content-Range"'
  if range="" then die("得不到.")                  '没有它就不知道下载完了没有'
  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是文件总字节数'
  if total-current=1 then exit do                            '结束位置比总大小少1就表示传输完成了'
  start=start+20480                                          '否则再下载20k'
loop while true

response.write chr(13)&"共下载了 ("&total&")."              '下载完了，显示总字节数'

function die(msg)                                              '函数名来自Perl内置函数die'
response.write msg                                              '交代遗言^_^'
response.end                                                  '去见马克思了'
end function

function showplan()                                            '显示下载进度'
if i mod 3 = 0 then c="/"                                      '简单的动态效果'
if i mod 3 = 1 then c="-"
if i mod 3 = 2 then c="\"
response.write chr(13)&"Download ("&current&") "&c&chr(8)'13号ASCII码是回到行首，8号是退格'
response.flush
end function


sub sleep(delaytime)
dim t1,t2,t3,ct,lt
t1=hour(time)*3600
t2=minute(time)*60
t3=second(time)
//把当前时间的小时，分钟转换成秒，存到ct里
ct=t1+t2+t3
//循环等待
do
t1=hour(time)*3600
t2=minute(time)*60
t3=second(time)
lt=t1+t2+t3
loop while(lt-ct<delaytime)
end sub
%>

<%
Option Explicit

Dim fso,aso,http,fo
Dim strRemoteFileUrl,strLocalFile

Dim nStartPos,nCurPos,Range,nTotalBytes,nPackage
Dim Temp,i

Set Fso = Server.CreateObject("Scripting.FileSystemObject")
Set Aso = Server.CreateObject("Adodb.Stream")
Set Http = Server.CreateObject("Microsoft.XmlHttp")

nPackage = 10240

strRemoteFileUrl = "http://www.yoursite.com/file.rar"
strLocalFile = "f:\down.file"
If Fso.FileExists(strLocalFile) Then
  nStartPos = Fso.GetFile(strLocalFile).Size
Else
  nStartPos = 0
  Set fo = Fso.CreateTextFile(strLocalFile)
  fo.Close
End If

nCurPos = nStartPos
Do
        Http.Open "GET",strRemoteFileUrl,True
        Http.SetRequestHeader "Range","Bytes = " & nStartPos & "-" & CStr(nStartPos + nPackage)
        Http.SetRequestHeader "Content-type:","Application/Octet-stream"
        Http.Send

        Do
        Loop While Http.ReadyState <> 4

        Aso.Type = 1
        Aso.Open
        Aso.LoadFromFile strLocalFile
        Aso.Position = nStartPos
        Aso.Write Http.ResponseBody
        Aso.SaveToFile strLocalFile, 2
        Aso.Close

        Range = Http.GetResponseHeader("Content-range")
        If Range = "" Then
                Response.Write "获取Range值时出错"
                Exit Do
        End If
        Temp = Mid(Range, InStr(Range, "-") + 1)
        response.write Range
        nCurPos = CLng(Left(Temp,InStr(Temp,"/") - 1))
        nTotalBytes = CLng(Mid(Temp,InStr(Temp, "/") + 1))
        If nTotalBytes - nCurPos = 1 Then Exit Do
        nStartPos = nStartPos + nPackage
        Response.Write nStartPos & "<br>"
Loop While True

Response.Write "下载成功"

%>