ASP下载时改文件名(重命名)与续传下载
成功志
ASP下载时改文件名(重命名)与续传下载
2012-5-29 ok12

文件 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即可




 

发表评论:
昵称

邮件地址 (选填)

个人主页 (选填)

内容