文件 download.html 内容
<html>
<body>
<a href="rename.asp" target="_blank" >改文件名（重命名下载）</a><br />
<a href="xuchuang.asp" target="_blank" >续传下载</a>
</body>
</html>
=============================================================
文件 rename.asp 内容 改文件名（重命名下载）
<%
'=可读数据库拿出新旧两文件名
call dl(Server.MapPath( "download/123456.docx"), "SQL存储过程实例.docx")
function dl(f,n)
on error resume next
Set S= server.CreateObject("Adodb.stream")
S.Mode=3
S.Type=1
S.Open
S.LoadFromFile(f)
if Err.Number> 0 then
Response.Status= "404 "
else
Response.ContentType= "application/octet-stream "
Response.AddHeader "Content-Disposition: ", "attachment; filename= " & n
Range=Mid(Request.ServerVariables( "HTTP_RANGE "),7)
'response.Write Range= ""
'response.End()
if Range= "" then
Response.BinaryWrite(S.Read)
else
S.position=Clng(Split(Range, "- ")(0))
Response.BinaryWrite(S.Read)
End if
end if
S.close
set S = nothing
Response.Flush
Response.End
end function
%>
=============================================================
文件 xuchuang.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"))
if Path<>"" then Path = Server.MapPath(Path)
'测试
FileName = "123456.doc"
Path="D:\web\download"
'防止盗链
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
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
%>
把以上3个文件和下载文件夹放于IIS站点运行download.html即可
发表评论