<%@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
%>