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 "下載成功"

%>