一个通过ASP下载文件的代码[ 支持断点,多线程 ]
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%><%Function ShowError(str)%>
<script language="javascript">
alert("<%=str%>");
location.target="_blank";
location.href="../vip/login.asp " ;
</script>
<%End Function
on error resume next
FileName=Trim(Request("FileName"))
Path=Trim(Request("Path"))
'防止盗链
From_url = Cstr(Request.ServerVariables("HTTP_REFERER"))
Serv_url = Cstr(Request.ServerVariables("SERVER_NAME"))
if mid(From_url,8,len(Serv_url)) <> Serv_url then
response.write "非法链接!"
response.end
end if
'检查权限
Path="E:\hello"
Const adTypeBinary=1
if FileName="" Then
Response.Write"无效文件名."
Response.End
End if
'下面是不希望下载的文件
FileExt=Mid(FileName,InStrRev(FileName,".")+1)
Select Case UCase(FileExt)
Case "ASP","ASA","ASPX","ASAX","MDB"
Response.Write"受保护文件,不能下载."
Response.End
End Select
set fileobj=server.CreateObject("Scripting.FileSystemObject")
dim retval
dim found
found=false
call FindFile(Path,FileName,retval)
if not fileobj.FileExists(retval) then
response.Write "没有找到文件,请与管理员联系"
response.End()
end if
set f=fileobj.GetFile(retval)
fileLength=f.Size
set fileobj=nothing
position=0
Response.Clear
'支持断点,多线程 下载文件
range=Request.ServerVariables("HTTP_Range")
if trim(range)<>"" then
Response.Status="206"
position=Clng(Replace(Replace(range,"bytes=",""),"-",""))
end if
if position<>0 then
Response.AddHeader "Content-Range","bytes "+CStr(position)+"-"+CStr(fileLength-1)+"/"+CStr(fileLength)
end if
Response.ContentType="application/octet-stream"
Response.AddHeader "content-disposition","attachment;filename="&FileName
Response.AddHeader "Content-Length",filelength-position
Set Stream=server.CreateObject("ADODB.Stream")
Stream.Type=adTypeBinary
Stream.Open
Stream.LoadFromFile retval
Stream.Position=position
While Not Stream.EOS
Response.BinaryWrite Stream.Read(1024*64)
Wend
Stream.Close
Set Stream=Nothing
Response.Flush
Response.End
function FindFile(path,filename,ByRef reval)
if found then
exit function
end if
set folder=fileobj.GetFolder(path)
if fileobj.FileExists(folder.path&"\"&filename) then
reval=folder.path&"\"&filename
found=true
Exit Function
else
set folders=fileobj.GetFolder(path).SubFolders
if folders.count<>0 then
for each myitem in folders
if fileobj.FileExists(myitem.path&"\"&filename) then
reval=myitem.path& "\" & filename
found=true
exit for
else
Call FindFile(myitem.path,filename,reval)
end if
next
end if
set folders=nothing
end if
End Function
%>