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

<%
'================================================================
'
'? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? 帶進度條的ASP無組件斷點續傳下載
'
'================================================================
'簡介：
'? ? ? ? 1)利用xmlhttp方式
'? ? ? ? 2)無組件
'? ? ? ? 3)異步方式獲取，節省服務器資源
'? ? ? ? 4)服務器到服務器的文件傳送。(當然，你自己電腦上的IIS也是http服務器)
'? ? ? ? 5)支持斷點續傳
'? ? ? ? 6)分段下載
'? ? ? ? 7)使用緩沖區，提升下載速度
'? ? ? ? 8)支持大文件下載(速度我就不說了，你可以測，用事實說話)
'? ? ? ? 9)帶進度條：下載百分比、下載量、即時下載速度、平均下載速度
'
'用法：
'? ? ? ? 設置好下面的三個變量，RemoteFileUrl、LocalFileUrl、RefererUrl
'
'================================================================
%>

<%'-----------------------------以下為設置部分--------------------------------%>
<%Server.Scripttimeout = 24 * 60 * 60? ? ? ? '腳本超時設置，這里設為24小時%>
<%
Dim RemoteFileUrl? ? ? ? '遠程文件路徑
Dim LocalFileUrl? ? ? ? '本地文件路徑,相對路徑，可以包含/及..

'速度問題注意：下面這個測試文件是在“網通”服務器上！！！
RemoteFileUrl = "http://hdt.driversky.com/down/foxmail60beta2.exe"
LocalFileUrl = "foxmail60beta2.exe"


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 = 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.Open
adosCacheSize = 4 * 1024 * 1024? ? ? ? '設為4M，獲取的數據先放到(內存)緩沖區中，當緩沖區滿的時候數據寫入磁盤

'若在自己的電腦上運行本程序，當下載百兆以上級別的大文件的時候，可設置大的緩沖區
'當然，也不要設的太大，免得發生(按下瀏覽器上的停止按鈕或斷電等)意外情況導致緩沖區中的數據沒有存盤，那緩沖區中的數據就白下載了
%>

<%
'先顯示html頭部
Response.Clear
Call HtmlHead()
Response.Flush
%>

<%
Dim ResponseRange? ? ? ? '服務器返回的http頭中的"Content-Range"
Dim CurrentLastBytes? ? ? ? '當前下載的結束位置(即ResponseRange中的上限)
Dim TotalBytes? ? ? ? '文件總字節數
Dim temp

'分段下載
DownStartTime = Now()

Do
? ? ? ? BlockStartTime = Timer()

? ? ? ? http.open "GET",RemoteFileUrl,true,"",""? ? ? ? '用異步方式調用serverxmlhttp

? ? ? ? '構造http頭
? ? ? ? http.setRequestHeader "Referer",RefererUrl
? ? ? ? http.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)"? ? ? ? '偽裝成Google
? ? ? ? http.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() - BlockStartTime
? ? ? ? ? ? ? ? If (temp > BlockTimeout) Then
? ? ? ? ? ? ? ? ? ? ? ? http.abort
? ? ? ? ? ? ? ? ? ? ? ? Response.Write "<script>document.getElementById(""status"").innerHTML=""<strong>錯誤：數據下載超時，建議重試。</strong>"";</script>" & vbNewLine & "</body></html>"
? ? ? ? ? ? ? ? ? ? ? ? Call ErrHandler()
? ? ? ? ? ? ? ? ? ? ? ? Call CloseObject()
? ? ? ? ? ? ? ? ? ? ? ? Response.End
? ? ? ? ? ? ? ? End If

? ? ? ? ? ? ? ? http.waitForResponse 1000? ? ? ? '等待1000毫秒
? ? ? ? Wend

? ? ? ? '檢測狀態
? ? ? ? If http.status = 416 Then? ? ? ? '服務器不能滿足客戶在請求中指定的Range頭。應當是已下載完畢。
? ? ? ? ? ? ? ? FileDownEnd = FileDownStart? ? ? ? '設置一下FileDownEnd，免得后面的FileDownBytes計算出錯
? ? ? ? ? ? ? ? Call CloseObject()
? ? ? ? ? ? ? ? Exit Do
? ? ? ? End 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.End
? ? ? ? End If

? ? ? ? '檢測狀態
? ? ? ? If http.status <> 206 Then? ? ? ? '服務器不支持斷點續傳
? ? ? ? ? ? ? ? Response.Write "<script>document.getElementById(""status"").innerHTML=""<strong>錯誤：服務器不支持斷點續傳！</strong>"";</script>" & vbNewLine & "</body></html>"
? ? ? ? ? ? ? ? Call ErrHandler()
? ? ? ? ? ? ? ? Call CloseObject()
? ? ? ? ? ? ? ? Response.End
? ? ? ? End If

? ? ? ? '檢測緩沖區是否已滿
? ? ? ? If adosCache.Size >= adosCacheSize Then
? ? ? ? ? ? ? ? '打開磁盤上的文件
? ? ? ? ? ? ? ? ados.Type = 1? ? ? ? '數據流類型設為字節
? ? ? ? ? ? ? ? ados.Mode = 3? ? ? ? '數據流訪問模式設為讀寫
? ? ? ? ? ? ? ? ados.Open
? ? ? ? ? ? ? ? ados.LoadFromFile LocalFileFullPhysicalPath? ? ? ? '打開文件
? ? ? ? ? ? ? ? ados.Position = ados.Size? ? ? ? '設置文件指針初始位置

? ? ? ? ? ? ? ? '將緩沖區數據寫入磁盤文件
? ? ? ? ? ? ? ? adosCache.Position = 0
? ? ? ? ? ? ? ? ados.Write adosCache.Read
? ? ? ? ? ? ? ? ados.SaveToFile LocalFileFullPhysicalPath,2? ? ? ? '覆蓋保存
? ? ? ? ? ? ? ? ados.Close

? ? ? ? ? ? ? ? '緩沖區復位
? ? ? ? ? ? ? ? adosCache.Position = 0
? ? ? ? ? ? ? ? adosCache.SetEOS
? ? ? ? End 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.End
? ? ? ? End If
? ? ? ? temp = 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 Then
? ? ? ? ? ? ? ? FileDownEnd = TotalBytes

? ? ? ? ? ? ? ? '將緩沖區數據寫入磁盤文件
? ? ? ? ? ? ? ? ados.Type = 1? ? ? ? '數據流類型設為字節
? ? ? ? ? ? ? ? ados.Mode = 3? ? ? ? '數據流訪問模式設為讀寫
? ? ? ? ? ? ? ? ados.Open
? ? ? ? ? ? ? ? ados.LoadFromFile LocalFileFullPhysicalPath? ? ? ? '打開文件
? ? ? ? ? ? ? ? ados.Position = ados.Size? ? ? ? '設置文件指針初始位置
? ? ? ? ? ? ? ? adosCache.Position = 0
? ? ? ? ? ? ? ? ados.Write adosCache.Read
? ? ? ? ? ? ? ? ados.SaveToFile LocalFileFullPhysicalPath,2? ? ? ? '覆蓋保存
? ? ? ? ? ? ? ? ados.Close

? ? ? ? ? ? ? ? Response.Write "<script>document.getElementById(""downsize"").innerHTML=""" & TotalBytes & """;</script>" & vbNewLine
? ? ? ? ? ? ? ? Response.Flush
? ? ? ? ? ? ? ? Call CloseObject()
? ? ? ? ? ? ? ? Exit Do? ? ? ? '結束位置比總大小少1就表示傳輸完成了
? ? ? ? End If

? ? ? ? '調整塊開始位置，準備下載下一個塊
? ? ? ? RangeStart = RangeStart + BlockSize

? ? ? ? '計算塊下載速度、進度條寬度、已下載的百分比
? ? ? ? BlockEndTime = Timer()
? ? ? ? temp = (BlockEndTime - BlockStartTime)
? ? ? ? If temp > 0 Then
? ? ? ? ? ? ? ? BlockAvgSpeed = Int(BlockSize / 1024 / temp)
? ? ? ? Else
? ? ? ? ? ? ? ? BlockAvgSpeed = ""
? ? ? ? End If
? ? ? ? percentWidth = 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>" & vbNewLine
? ? ? ? Response.Flush
Loop While Response.IsClientConnected

If Not Response.IsClientConnected Then
? ? ? ? Response.End
End If

DownEndTime = Now()
FileDownBytes = FileDownEnd - FileDownStart
temp = DateDiff("s",DownStartTime,DownEndTime)
If (FileDownBytes <> 0) And (temp <> 0) Then
? ? ? ? DownAvgSpeed = Int((FileDownBytes / 1024) / temp)
Else
? ? ? ? DownAvgSpeed = ""
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 = Nothing
? ? ? ? Set http = Nothing
? ? ? ? adosCache.Close
? ? ? ? Set adosCache = Nothing
End Sub
%>

<%
'http異常退出處理代碼
Sub ErrHandler()
? ? ? ? Dim fso

? ? ? ? Set fso = Server.CreateObject("Scripting.FileSystemObject")
? ? ? ? If fso.FileExists(LocalFileFullPhysicalPath) Then? ? ? ? '判斷要下載的文件是否已經存在
? ? ? ? ? ? ? ? If fso.GetFile(LocalFileFullPhysicalPath).Size = 0 Then? ? ? ? '若文件大小為0
? ? ? ? ? ? ? ? ? ? ? ? fso.DeleteFile LocalFileFullPhysicalPath? ? ? ? '刪除文件
? ? ? ? ? ? ? ? End If
? ? ? ? End If
? ? ? ? Set fso = Nothing
End Sub
%>

<%Sub HtmlHead()%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>帶進度條的ASP無組件斷點續傳下載</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,t
? ? ? ? If s < 1 Then
? ? ? ? ? ? ? ? S2T = (s * 1000) & "毫秒"
? ? ? ? Else
? ? ? ? ? ? ? ? s = Int(s)
? ? ? ? ? ? ? ? x = Int(s / 3600)
? ? ? ? ? ? ? ? t = s - 3600 * x
? ? ? ? ? ? ? ? y = Int(t / 60)
? ? ? ? ? ? ? ? z = t - 60 * y
? ? ? ? ? ? ? ? If x > 0 Then
? ? ? ? ? ? ? ? ? ? ? ? S2T = x & "小時" & y & "分" & z & "秒"
? ? ? ? ? ? ? ? Else
? ? ? ? ? ? ? ? ? ? ? ? If y > 0 Then
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? S2T = y & "分" & z & "秒"
? ? ? ? ? ? ? ? ? ? ? ? Else
? ? ? ? ? ? ? ? ? ? ? ? ? ? ? ? S2T = z & "秒"
? ? ? ? ? ? ? ? ? ? ? ? End If
? ? ? ? ? ? ? ? End If
? ? ? ? End If
End Function
'--------------------------------------------------------------------
%>

轉載于:https://www.cnblogs.com/MaxIE/archive/2007/01/11/617655.html

總結

以上是生活随笔為你收集整理的ASP无组件上传带进度条的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。