ASP non-component breakpoint renewal download with progress bar

No Components | download

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

<%option explicit%>
<%

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

"" with progress bar ASP No component breakpoint continued download

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

Introduction

' 1 Using XMLHTTP method

' 2) No components

' 3 asynchronous way to get, save server resources

' 4 server to server file transfer. (Of course, IIS on your own computer is also an HTTP server)

' 5 Support breakpoint continuation

' 6) sub-download

' 7 use buffer to increase download speed

' 8 support large file download (speed I will not say, you can test, speak with the fact)

' 9 with progress bar: Download percentage, download amount, Instant download speed, average download speed

'

Usage

' Set the following three variables, Remotefileurl, Localfileurl, Refererurl

'

' Author: Midnight Crazy Dragon (Madpolice)

' Madpolice_dong@163.com

' 2005.12.25

' ===============================%>
                        
<% '------------for the Settings section------

<%server.scripttimeout = 24 * 60 * 60 ' script timeout setting, set to 24 hours%>

<%

Dim remotefileurl ' Remote file path

Dim localfileurl ' local file path, relative path, can contain/and ...
                        
Remotefileurl = "Http://202.102.14.137/win98.zip"

Localfileurl = "Win98.zip"
                                                


Dim Refererurl

' This property sets the reference page for the file download,

' Some sites only allow files to be downloaded through the connections within their site,

' The servers in these sites judge whether the user is clicking on a file link within their site that is the attribute.

Refererurl = "http://www.skycn.com/crack_skycn.html" can be left blank if the remote server is not restricted
                        
Dim BlockSize ' segmented download block size

Dim blocktimeout ' Download block timeout (in seconds)
                        
BlockSize = 128 * 1024 ' 128K, download per second measured in 1M bandwidth
                        
(Bandwidth divided by 8 according to your own bandwidth), it is recommended not to set too small

Blocktimeout = 64 ' should be set according to the size of the block. This is set to 64 seconds.
                        
Timeout if 128K of data is not downloaded for 64 seconds (2K conservative estimate per second).
                        
Dim Percenttablewidth ' progress bar total width
                        
Percenttablewidth = 560

%>

<% '--------------------above for the set part---------------%>
                        
<%

'***********************************

'！！！ The following need not be modified!!!

'***********************************

%>

<%

Dim Localfilefullphysicalpath ' The absolute path of the local file on the hard disk
                        
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 "The server does not support MSXML, this program cannot run!" "

Response.End

End If

End If

End If

End If

End If

On Error Goto 0
                        
Set ADOs = Server.CreateObject ("adodb.stream")

%>
                        
<%

Dim rangestart ' segmented download start position

Dim FSO
                        
Set FSO = Server.CreateObject ("Scripting.FileSystemObject")

If FSO. FileExists (Localfilefullphysicalpath)
                        
Then ' Determine if the file you want to download already exists

RangeStart = fso. GetFile (Localfilefullphysicalpath). Size ' If present, the current file size as the starting position

Else

RangeStart = 0 ' If it doesn't exist, everything starts from scratch

Fso. CreateTextFile (Localfilefullphysicalpath). Close ' new file

End If

Set FSO = Nothing

%>
                        
<%

Dim Filedownstart ' starting position for this download

Dim filedownend ' End location for this download

Dim filedownbytes ' number of bytes downloaded this time

Dim downstarttime ' Start download time

Dim downendtime ' Complete download time

Dim downavgspeed ' average download speed
                        
Dim blockstarttime ' block start download time

Dim blockendtime ' block complete download time

Dim blockavgspeed ' block average download speed
                        
Dim percentwidth ' The width of the progress bar

Dim downpercent '% downloaded
                        
Filedownstart = RangeStart

%>
                        
<%

Dim adoscache ' data buffer

Dim adoscachesize ' buffer size
                        
Set Adoscache = Server.CreateObject ("adodb.stream")

Adoscache.type = 1 ' data flow type set to Byte

Adoscache.mode = 3 ' Data flow access mode set to read-write

Adoscache.open

Adoscachesize = 4 * 1024 * 1024 ' set to 4M,
                        
The obtained data is first put into the (memory) buffer and the data is written to disk when the buffer is full
                        
' If you run this program on your own computer, you can set up a large buffer when downloading large files above the level of megabytes

' Of course, do not set too large, lest occur (press the Stop button on the browser or power off, etc.)
                        
The unexpected situation caused the data in the buffer to not be saved, and the data in the buffer was downloaded in white.

%>
                        
<%

' Show HTML headers first

Response.Clear

Call HtmlHead ()

Response.Flush

%>
                        
<%

Dim responserange ' content-range ' in the HTTP header returned by the server

Dim Currentlastbytes ' The end position of the current download (that is, the upper limit in Responserange)

Dim totalbytes ' Total bytes of file

Dim Temp
                        
' Segmented download

Downstarttime = Now ()
                        
Todo

Blockstarttime = Timer ()
                        
Http.open "Get", Remotefileurl,true, "" "," "" is invoked asynchronously ServerXMLHTTP
                        
' Construct HTTP Headers

Http.setrequestheader "Referer", Refererurl

Http.setrequestheader "Accept", "*/*"

Http.setrequestheader "User-agent", "baiduspider+" (
                        
+http://www.baidu.com/search/spider.htm) "' disguised as Baidu

' Http.setrequestheader ' user-agent ', ' googlebot/2.1 (
                        
+http://www.google.com/bot.html) "' disguised as Google

Http.setrequestheader "Range", "bytes=
                        
"& RangeStart &"-"& Cstr (RangeStart + BlockSize-1)" segment key

Http.setrequestheader "Content-type", "application/octet-stream"

Http.setrequestheader "Pragma", "No-cache"

Http.setrequestheader "Cache-control", "No-cache"
                        
Http.send ' send
                        
' Loop wait for data to receive

while (Http.readystate <> 4)

' Judge whether the block timed out

temp = Timer ()-Blockstarttime

If (Temp > Blocktimeout) Then

Http.abort

Response.Write "<script>document.getelementbyid" ("status"). InnerHTML= "" <strong>
                        
Error: Data download timed out, recommended retry.
                        
</strong> ";</script>" & vbNewLine & "</body>
Call ErrHandler ()

Call Closeobject ()

Response.End

End If
                        
Http.waitforresponse 1000 ' Wait 1000 milliseconds

Wend
                        
' Detection status

If http.status = 416 Then ' Server cannot meet the range header specified by the customer in the request. should be finished downloading.

Filedownend = Filedownstart ' Set the Filedownend, lest the Filedownbytes calculation error

Call Closeobject ()

Exit do

End If
                        
' Detection status

If http.status > 299 Then ' http error

Response.Write "<script>document.getelementbyid" ("status"). InnerHTML= "" <strong>http
                        
Error: "& Http.status &" "& Http.statustext &" </strong> ";
                        
</script> "& vbNewLine &" </body>
Call ErrHandler ()

Call Closeobject ()

Response.End

End If
                        
' Detection status

If http.status <> 206 Then ' server does not support breakpoint continuation

Response.Write "<script>document.getelementbyid" ("status"). InnerHTML= "" <strong>
                        
Error: Server does not support breakpoint continuation! </strong> ";</script>" & vbNewLine & "</body>
Call ErrHandler ()

Call Closeobject ()

Response.End

End If
                        
' Detect if the buffer is full

If adoscache.size >= adoscachesize Then

' Open a file on disk

ADOs. Type = 1 ' Data flow type is set to byte

ADOs. mode = 3 ' Data flow access mode set to read-write

ADOs. Open

ADOs. LoadFromFile Localfilefullphysicalpath ' Open file

ADOs. Position = ADOs. Size ' Set the initial position of the file pointer
                        
' Write buffer data to a disk file

adoscache.position = 0

ADOs. Write Adoscache.read

ADOs. SaveToFile localfilefullphysicalpath,2 ' overwrite save

ADOs. Close
                        
' Buffer reset

adoscache.position = 0

Adoscache.seteos

End If

' Save block data to Buffer

Adoscache.write http.responsebody ' Write data
                        
' Determine if all (block) downloads are complete

Responserange = Http.getresponseheader ("Content-range") ' Obtains ' Content-range ' in HTTP header

If Responserange = "Then ' Without it I don't know if the download is over.

Response.Write "<script>document.getelementbyid" ("status"). InnerHTML= "" <strong>
                        
Error: File length unknown! </strong> ";</script>" & vbNewLine & "</body>
Call Closeobject ()

Response.End

End If

temp = Mid (Responserange,instr (Responserange, "-") +1) ' Content-range is similar to 123-456/789

Currentlastbytes = CLNG (left (temp,instr (temp, "/")-1)) ' 123 is the starting position, 456 is the end position

TotalBytes = CLNG (Mid (Temp,instr (temp, "/") +1)) ' 789 is the total number of bytes in the file

If totalbytes-currentlastbytes = 1 Then

Filedownend = TotalBytes
                        
' Write buffer data to a disk file

ADOs. Type = 1 ' Data flow type is set to byte

ADOs. mode = 3 ' Data flow access mode set to read-write

ADOs. Open

ADOs. LoadFromFile Localfilefullphysicalpath ' Open file

ADOs. Position = ADOs. Size ' Set the initial position of the file pointer

adoscache.position = 0

ADOs. Write Adoscache.read

ADOs. SaveToFile localfilefullphysicalpath,2 ' overwrite save

ADOs. Close
                        
Response.Write "<script>document.getelementbyid
                        
("downsize"). InnerHTML= "" "& TotalBytes &" "";
                        
</script> "& vbNewLine

Response.Flush

Call Closeobject ()

Exit do ' end position 1 less than total size means the transfer is complete

End If

' Adjust block start position, ready to download next block

RangeStart = RangeStart + BlockSize
                        
' Compute block download speed, progress bar width,% downloaded

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 (M * rangestart/totalbytes)
                        
' Update progress bar

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
                        
' Update progress bar after all downloads have been completed

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> download completed!
                        
Spents: "& s2t (DateDiff (" s ", Downstarttime,downendtime)) &",
                        
Average download speed: "& downavgspeed &" K/sec </strong> "";</script> "& vbNewLine

%>
                        
</body>

                        
<%

Sub Closeobject ()

Set ADOs = Nothing

Set http = Nothing

Adoscache.close

Set Adoscache = Nothing

End Sub

%>
                        
<%

' HTTP exception exit handling code

Sub ErrHandler ()

Dim FSO
                        
Set FSO = Server.CreateObject ("Scripting.FileSystemObject")

If FSO. FileExists (Localfilefullphysicalpath) Then ' Determine if the file you want to download already exists

If FSO. GetFile (Localfilefullphysicalpath). Size = 0 Then ' If file size is 0

Fso. DeleteFile Localfilefullphysicalpath ' Delete file

End If

End If

Set FSO = Nothing

End Sub

%>
                        
<%sub HtmlHead ()%>



<meta http-equiv= "Content-type" content= "text/html; charset=gb2312 ">

<title> with progress bar ASP no component breakpoint download----Author: Midnight Dragon (Madpolice)--2005.12.25</title>


<body>

<div id= "status" > Downloading <span style= "Color:blue" >
                        
<%=RemoteFileUrl%></span>, please wait ...</div>

<div> </div>

<div id= "Progress" > Completed: <span id= "downpercent" style= "Color:green" >
                        
</span> <span id= "downsize" style= "color:red" ><%=RangeStart%>
                        
</span>/<span id= "TotalBytes" style= "Color:blue" >
                        
</span> bytes (<span id= "Blockavgspeed" ></span>k/sec) </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= ">"

<td>

<table border= "0" width= "" cellspacing= "1" bgcolor= "#0033FF" id= "PercentDone" >

<tr>

<td> <td>

</tr>

</table>

</td>

</tr>

</table>

</div>

<%end sub%>
                        
<%

'------------------------------

' Converts the number of seconds to the X hour y-minute Z-second form

'------------------------------

Function s2t (ByVal s)

Dim x,y,z,t

If S < 1 Then

S2T = (S * 1000) & "MS"

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 & "h" & Y & "Minutes" & Z & "SEC"

Else

If y > 0 Then

s2t = y & "min" & Z & "SEC"

Else

S2T = Z & "SEC"

End If

End If

End If

End Function

'-----------------------

%>