asp 下载函数

N久没搞ASP啦,今天一个网友问到这个问题.就在网上找了下.

也不知道这个有没有错误.

下载的基本思路是这个样子的.

代码如下:

<%



Const USE_STREAM = 0 '0.不用流(Adodb.Stream)下载 1.用流下载

Const ALLOW_FILE_EXT = "rar,zip,chm,doc,xls,swf,mp3,gif,jpg,jpeg,png,bmp" '允许下载的文件的扩展名，防止源代码被下载



Dim sDownFilePath '下载文件路径

sDownFilePath = Trim(Request("FilePath"))

'或者根据传过来的文件ID从数据库中获取文件路径



'如果 sDownFilePath 为绝对路径，一定要将 sDownFilePath 转换为相对 本文件的相对路径



'sDownFilePath = "focus.swf"



Call DownloadFile(sDownFilePath)



Function DownloadFile(s_DownFilePath)

    '判断有没传递文件名

    If IsNull(s_DownFilePath) = True Or Trim(s_DownFilePath) = "" Then

        OutputErr "错误：先确定要下载的文件，下载失败"

    End If



    '判断扩展名是否合法

    Dim s_FileExt

    s_FileExt = Mid(s_DownFilePath, InstrRev(s_DownFilePath, ".")+1)

    If InStr("," & ALLOW_FILE_EXT & ",", "," & s_FileExt & ",") <= 0 Then

        OutputErr "错误：文件类型（" & s_FileExt & "）不允许被下载，下载失败"

    End If

    

    s_DownFilePath = Replace(s_DownFilePath, "/", "/")



    '为了安全，某些目录禁止下载文件，在这里处理

    '

    

    '检测服务器是否支持fso

    Dim o_Fso

    On Error Resume Next

    Set o_Fso = Server.CreateObject("Scripting.FileSystemObject")

    If Err.Number <> 0 Then

        Err.Clear

        OutputErr "错误：服务器不支持fso组件，下载失败"

    End If



    '取得文件名，文件大小

    Dim s_FileMapPath

    Dim o_File, s_FileName, n_FileLength

    s_FileMapPath = Server.MapPath(s_DownFilePath)

    If (o_Fso.FileExists(s_FileMapPath)) = True Then

        Set o_File = o_Fso.GetFile(s_FileMapPath)

        s_FileName = o_File.Name

        n_FileLength = o_File.Size

        o_File.Close

    Else

        OutputErr "错误：文件不存在，下载失败"

    End If

    Set o_Fso = Nothing



    '判断是否下载的文件大小超过限制

    '    

    

    '如果不是用流下载，直接转到该文件

    If USE_STREAM = 0 Then

        Response.Redirect sDownFilePath

        Response.end

    End If



    '检测服务器是否支持Adodb.Stream

    On Error Resume Next

    Set o_Stream = Server.CreateObject("Adodb.Stream")

    If Err.Number <> 0 Then

        Err.Clear

        OutputErr "错误：服务器不支持Adodb.Stream组件，下载失败"

    End If



    o_Stream.Tyep = 1

    o_Stream.Open

    o_Stream.LoadFromFile s_FileMapPath 



    Response.Buffer = True

    Response.Clear

    Response.AddHeader "Content-Disposition", "attachment; filename=" & s_FileName

    Response.AddHeader "Content-Length", n_FileLength 

    Response.CharSet = "UTF-8" 

    Response.ContentType = "application/octet-stream" 

    Response.BinaryWrite o_Stream.Read

    Response.Flush



    o_Stream.Close

    Set o_Stream = Nothing



End Function



Sub OutputErr(s_ErrMsg)

    Response.Write "<font color=red>" & s_ErrMsg & "</font>" 

    Response.End

End Sub



%>