文件上传类.asp

<%
Class UpLoadClass

    Private m_TotalSize,m_MaxSize,m_FileType,m_SavePath,m_AutoSave,m_Error,m_Charset
    Private m_dicForm,m_binForm,m_binItem,m_strDate,m_lngTime
    Public    FormItem,FileItem

    Public Property Get Error
        Error=m_Error
    End Property

    Public Property Get Charset
        Charset=m_Charset
    End Property
    Public Property Let Charset(strCharset)
        m_Charset=strCharset
    End Property

    Public Property Get TotalSize
        TotalSize=m_TotalSize
    End Property
    Public Property Let TotalSize(lngSize)
        if isNumeric(lngSize) then m_TotalSize=Clng(lngSize)
    End Property

    Public Property Get MaxSize
        MaxSize=m_MaxSize
    End Property
    Public Property Let MaxSize(lngSize)
        if isNumeric(lngSize) then m_MaxSize=Clng(lngSize)
    End Property

    Public Property Get FileType
        FileType=m_FileType
    End Property
    Public Property Let FileType(strType)
        m_FileType=strType
    End Property

    Public Property Get SavePath
        SavePath=m_SavePath
    End Property
    Public Property Let SavePath(strPath)
        m_SavePath=Replace(strPath,chr(0),"")
    End Property

    Public Property Get AutoSave
        AutoSave=m_AutoSave
    End Property
    Public Property Let AutoSave(byVal Flag)
        select case Flag
            case 0,1,2: m_AutoSave=Flag
        end select
    End Property

    Private Sub Class_Initialize
        m_Error       = -1
        m_Charset  = "gb2312"
        m_TotalSize= 0
        m_MaxSize  = 153600
        m_FileType = "jpg/gif"
        m_SavePath = ""
        m_AutoSave = 0
        Dim dtmNow : dtmNow = Date()
        m_strDate  = Year(dtmNow)&Right("0"&Month(dtmNow),2)&Right("0"&Day(dtmNow),2)
        m_lngTime  = Clng(Timer()*1000)
        Set m_binForm = Server.CreateObject("ADODB.Stream")
        Set m_binItem = Server.CreateObject("ADODB.Stream")
        Set m_dicForm = Server.CreateObject("Scripting.Dictionary")
        m_dicForm.CompareMode = 1
    End Sub

    Private Sub Class_Terminate
        m_dicForm.RemoveAll
        Set m_dicForm = nothing
        Set m_binItem = nothing
        m_binForm.Close()
        Set m_binForm = nothing
    End Sub

    Public Function Open()
        Open = 0
        if m_Error=-1 then
            m_Error=0
        else
            Exit Function
        end if
        Dim lngRequestSize : lngRequestSize=Request.TotalBytes
        if m_TotalSize>0 and lngRequestSize>m_TotalSize then
            m_Error=5
            Exit Function
        elseif lngRequestSize<1 then
            m_Error=4
            Exit Function
        end if

        Dim lngChunkByte : lngChunkByte = 102400
        Dim lngReadSize : lngReadSize = 0
        m_binForm.Type = 1
        m_binForm.Open()
        do
            m_binForm.Write Request.BinaryRead(lngChunkByte)
            lngReadSize=lngReadSize+lngChunkByte
            if  lngReadSize >= lngRequestSize then exit do
        loop       
        m_binForm.Position=0
        Dim binRequestData : binRequestData=m_binForm.Read()

        Dim bCrLf,strSeparator,intSeparator
        bCrLf=ChrB(13)&ChrB(10)
        intSeparator=InstrB(1,binRequestData,bCrLf)-1
        strSeparator=LeftB(binRequestData,intSeparator)

        Dim strItem,strInam,strFtyp,strPuri,strFnam,strFext,lngFsiz
        Const strSplit="'"">"
        Dim strFormItem,strFileItem,intTemp,strTemp
        Dim p_start : p_start=intSeparator+2
        Dim p_end
        Do
            p_end = InStrB(p_start,binRequestData,bCrLf&bCrLf)-1
            m_binItem.Type=1
            m_binItem.Open()
            m_binForm.Position=p_start
            m_binForm.CopyTo m_binItem,p_end-p_start
            m_binItem.Position=0
            m_binItem.Type=2
            m_binItem.Charset=m_Charset
            strItem = m_binItem.ReadText()
            m_binItem.Close()
            intTemp=Instr(39,strItem,"""")
            strInam=Mid(strItem,39,intTemp-39)

            p_start = p_end + 4
            p_end = InStrB(p_start,binRequestData,strSeparator)-1
            m_binItem.Type=1
            m_binItem.Open()
            m_binForm.Position=p_start
            lngFsiz=p_end-p_start-2
            m_binForm.CopyTo m_binItem,lngFsiz

            if Instr(intTemp,strItem,"filename=""")<>0 then
            if not m_dicForm.Exists(strInam&"_From") then
                strFileItem=strFileItem&strSplit&strInam
                if m_binItem.Size<>0 then
                    intTemp=intTemp+13
                    strFtyp=Mid(strItem,Instr(intTemp,strItem,"Content-Type: ")+14)
                    strPuri=Mid(strItem,intTemp,Instr(intTemp,strItem,"""")-intTemp)
                    intTemp=InstrRev(strPuri,"/")
                    strFnam=Mid(strPuri,intTemp+1)
                    m_dicForm.Add strInam&"_Type",strFtyp
                    m_dicForm.Add strInam&"_Name",strFnam
                    m_dicForm.Add strInam&"_Path",Left(strPuri,intTemp)
                    m_dicForm.Add strInam&"_Size",lngFsiz
                    if Instr(strFnam,".")<>0 then
                        strFext=Mid(strFnam,InstrRev(strFnam,".")+1)
                    else
                        strFext=""
                    end if

                    select case strFtyp
                    case "image/jpeg","image/pjpeg","image/jpg"
                        if Lcase(strFext)<>"jpg" then strFext="jpg"
                        m_binItem.Position=3
                        do while not m_binItem.EOS
                            do
                                intTemp = Ascb(m_binItem.Read(1))
                            loop while intTemp = 255 and not m_binItem.EOS
                            if intTemp < 192 or intTemp > 195 then
                                m_binItem.read(Bin2Val(m_binItem.Read(2))-2)
                            else
                                Exit do
                            end if
                            do
                                intTemp = Ascb(m_binItem.Read(1))
                            loop while intTemp < 255 and not m_binItem.EOS
                        loop
                        m_binItem.Read(3)
                        m_dicForm.Add strInam&"_Height",Bin2Val(m_binItem.Read(2))
                        m_dicForm.Add strInam&"_Width",Bin2Val(m_binItem.Read(2))
                    case "image/gif"
                        if Lcase(strFext)<>"gif" then strFext="gif"
                        m_binItem.Position=6
                        m_dicForm.Add strInam&"_Width",BinVal2(m_binItem.Read(2))
                        m_dicForm.Add strInam&"_Height",BinVal2(m_binItem.Read(2))
                    case "image/png","image/x-png"
                        if Lcase(strFext)<>"png" then strFext="png"
                        m_binItem.Position=18
                        m_dicForm.Add strInam&"_Width",Bin2Val(m_binItem.Read(2))
                        m_binItem.Read(2)
                        m_dicForm.Add strInam&"_Height",Bin2Val(m_binItem.Read(2))
                    case "image/bmp"
                        if Lcase(strFext)<>"bmp" then strFext="bmp"
                        m_binItem.Position=18
                        m_dicForm.Add strInam&"_Width",BinVal2(m_binItem.Read(4))
                        m_dicForm.Add strInam&"_Height",BinVal2(m_binItem.Read(4))
                    case "application/x-shockwave-flash"
                        if Lcase(strFext)<>"swf" then strFext="swf"
                        m_binItem.Position=0
                        if Ascb(m_binItem.Read(1))=70 then
                            m_binItem.Position=8
                            strTemp = Num2Str(Ascb(m_binItem.Read(1)), 2 ,8)
                            intTemp = Str2Num(Left(strTemp, 5), 2)
                            strTemp = Mid(strTemp, 6)
                            while (Len(strTemp) < intTemp * 4)
                                strTemp = strTemp & Num2Str(Ascb(m_binItem.Read(1)), 2 ,8)
                            wend
                            m_dicForm.Add strInam&"_Width", Int(Abs(Str2Num(Mid(strTemp, intTemp + 1, intTemp), 2) - Str2Num(Mid(strTemp, 1, intTemp), 2)) / 20)
                            m_dicForm.Add strInam&"_Height",Int(Abs(Str2Num(Mid(strTemp, 3 * intTemp + 1, intTemp), 2) - Str2Num(Mid(strTemp, 2 * intTemp + 1, intTemp), 2)) / 20)
                        end if
                    end select

                    m_dicForm.Add strInam&"_Ext",strFext
                    m_dicForm.Add strInam&"_From",p_start
                    intTemp=GetFerr(lngFsiz,strFext)
                    if m_AutoSave<>2 then
                        m_dicForm.Add strInam&"_Err",intTemp
                        if intTemp=0 then
                            if m_AutoSave=0 then
                                strFnam=GetTimeStr()
                                if strFext<>"" then strFnam=strFnam&"."&strFext
                            end if
                            m_binItem.SaveToFile Server.MapPath(m_SavePath&strFnam),2 
                            m_dicForm.Add strInam,strFnam
                        end if
                    end if
                else
                    m_dicForm.Add strInam&"_Err",-1
                end if
            end if
            else
                m_binItem.Position=0
                m_binItem.Type=2
                m_binItem.Charset=m_Charset
                strTemp=m_binItem.ReadText
                if m_dicForm.Exists(strInam) then
                    m_dicForm(strInam) = m_dicForm(strInam)&","&strTemp
                else
                    strFormItem=strFormItem&strSplit&strInam
                    m_dicForm.Add strInam,strTemp
                end if
            end if

            m_binItem.Close()
            p_start = p_end+intSeparator+2
        loop Until p_start+3>lngRequestSize
        FormItem=Split(strFormItem,strSplit)
        FileItem=Split(strFileItem,strSplit)
       
        Open = lngRequestSize
    End Function

    Private Function GetTimeStr()
        m_lngTime=m_lngTime+1
        GetTimeStr=m_strDate&Right("00000000"&m_lngTime,8)
    End Function

    Private Function GetFerr(lngFsiz,strFext)
        dim intFerr
        intFerr=0
        if lngFsiz>m_MaxSize and m_MaxSize>0 then
            if m_Error=0 or m_Error=2 then m_Error=m_Error+1
            intFerr=intFerr+1
        end if
        if Instr(1,LCase("/"&m_FileType&"/"),LCase("/"&strFext&"/"))=0 and m_FileType<>"" then
            if m_Error<2 then m_Error=m_Error+2
            intFerr=intFerr+2
        end if
        GetFerr=intFerr
    End Function

    Public Function Save(Item,strFnam)
        Save=false
        if m_dicForm.Exists(Item&"_From") then
            dim intFerr,strFext
            strFext=m_dicForm(Item&"_Ext")
            intFerr=GetFerr(m_dicForm(Item&"_Size"),strFext)
            if m_dicForm.Exists(Item&"_Err") then
                if intFerr=0 then
                    m_dicForm(Item&"_Err")=0
                end if
            else
                m_dicForm.Add Item&"_Err",intFerr
            end if
            if intFerr<>0 then Exit Function
            if VarType(strFnam)=2 then
                select case strFnam
                    case 0:strFnam=GetTimeStr()
                        if strFext<>"" then strFnam=strFnam&"."&strFext
                    case 1:strFnam=m_dicForm(Item&"_Name")
                end select
            end if
            m_binItem.Type = 1
            m_binItem.Open
            m_binForm.Position = m_dicForm(Item&"_From")
            m_binForm.CopyTo m_binItem,m_dicForm(Item&"_Size")
            m_binItem.SaveToFile Server.MapPath(m_SavePath&strFnam),2   ‘1为不可覆盖，2为可覆盖
            m_binItem.Close()
            if m_dicForm.Exists(Item) then
                m_dicForm(Item)=strFnam
            else
                m_dicForm.Add Item,strFnam
            end if
            Save=true
        end if
    End Function

    Public Function GetData(Item)
        GetData=""
        if m_dicForm.Exists(Item&"_From") then
            if GetFerr(m_dicForm(Item&"_Size"),m_dicForm(Item&"_Ext"))<>0 then Exit Function
            m_binForm.Position = m_dicForm(Item&"_From")
            GetData=m_binForm.Read(m_dicForm(Item&"_Size"))
        end if
    End Function

    Public Function Form(Item)
        if m_dicForm.Exists(Item) then
            Form=m_dicForm(Item)
        else
            Form=""
        end if
    End Function

    Private Function BinVal2(bin)
        dim lngValue,i
        lngValue = 0
        for i = lenb(bin) to 1 step -1
            lngValue = lngValue *256 + Ascb(midb(bin,i,1))
        next
        BinVal2=lngValue
    End Function

    Private Function Bin2Val(bin)
        dim lngValue,i
        lngValue = 0
        for i = 1 to lenb(bin)
            lngValue = lngValue *256 + Ascb(midb(bin,i,1))
        next
        Bin2Val=lngValue
    End Function

    Private Function Num2Str(num, base, lens)
        Dim ret,i
        ret = ""
        while(num >= base)
            i   = num Mod base
            ret = i & ret
            num = (num - i) / base
        wend
        Num2Str = Right(String(lens, "0") & num & ret, lens)
    End Function
   
    Private Function Str2Num(str, base)
        Dim ret, i
        ret = 0
        for i = 1 to Len(str)
            ret = ret * base + Cint(Mid(str, i, 1))
        next
        Str2Num = ret
    End Function
End Class
%>
<!--
***************************************************************************************
　　使用UpLoadClass对象可以处理一个HTTP表单上传二进制数据（文件）到服务器，其形式模拟ASP内置对象Request。上传的处理要创建一个UpLoadClass对象实例，可以使用<'%Set request2=new UpLoadClass%>
-------------------------------------------------------------
参数属性
 
MaxSize 每个上传文件的最大字节数
默认值：153600
特征值：0表示文件大小不受限制
 
FileType 允许上传的文件类型
默认值："gif/jpg"
特征值：""表示文件类型不受限制（空）
 
SavePath 文件存放的路径，可以是相对路径
默认值：""　即当前目录

AutoSave 设置Open方法处理文件的方式，对其他方法无效
默认值：0
可选值：
　　0：取无重复的服务器时间字符串为文件名自动保存文件
　　1：取源文件名自动保存文件
　　2：不自动保存文件，Open之后请用Save/GetData方法保存文件

--------------------------------------------------------------
方法
 
Sub Open()
打开对象，打开之前可以重定义对象参数属性MaxSize等
每个实例均需调用的方法。

Function Save(Item,Name)
保存文件，成功保存返回ture,否则返回false
Item是表单中file元素
Name是保存的文件名，可选值：
　　０：自动取无重复的服务器时间字符串为文件名
　　１：自动取源文件名
　　字符串：自定义的文件名，如"mypic.jpg"

Function Form(Item)
对于其他表单元素：(假设表单元素名为item)
　　Form(item)　　      表单元素对应的Value值
对于file表单元素：(假设表单元素名为item)
　　Form(item)　　　　　文件上传后的文件名
　　Form(item&"_Type")　文件类型，例"image/gif"
　　Form(item&"_Name")　原文件名
　　Form(item&"_Path")　原文件本地上传路径
　　Form(item&"_Size")　文件字节数
　　Form(item&"_Ext") 　文件扩展名
　　Form(item&"_Err") 　该文件上传状态
　　　　-1：没有文件上传
　　　　0：正常
　　　　1：文件超过大小
　　　　2：文件类型不正确
　　　　3：文件超过大小,类型不正确
对于images类file表单元素还有：(假设表单元素名为item)
　　Form(item&"_Width") 图片宽度
　　Form(item&"_Height")图片高度
 
Function GetData(Item)
获取数据流，可用来保存文件到数据库，试图获取非文件数据时返回空值

----------------------------------------------------------------
返回属性（只读）
  
Version 返回类版本说明
 
Error 返回当前文件保存状态
-1：对象尚未打开,请先Open打开对象
0：正常
1：有文件超过大小
2：有文件类型不正确
3：有文件超过大小,类型不正确
4：异常退出
 
FormItem 保存Post表单中文本域名称的数组，下标从1开始
 
FileItem 保存Post表单中文件域名称的数组，下标从1开始
******************************************************************************************
ASP 0104 : 80004005 错误的解决办法

这个错误可能出现在添加新闻,生成首页等情况下.原因是IIS本身默认的限制,IIS6.0禁止上传超过200kB 的文件.生成文件,添加文件都不可以超过200K, 因此你需要修改 IIS 的默认设置. 然后在服务里关闭iis admin service服务
找到windows/system32/inesrv/下的metabase.xml文件,打开，找到ASPMaxRequestEntityAllowed 把它修改为需要的值，
默认为204800即200K，把它修改为51200000（50M）或者更大,然后重启iis admin service服务即可。

-->

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
                                                  无惧上传类 V2.2
<%
'----------------------------------------------------------------------
'转发时请保留此声明信息,这段声明不并会影响你的速度!
'*******************     无惧上传类 V2.2    ************************************
'作者:梁无惧
'网站:http://www.25cn.com
'电子邮件:yjlrb@21cn.com
'版权声明:版权所有,源代码公开,各种用途均可免费使用,但是修改后必须把修改后的文件
'发送一份给作者.并且保留作者此版权信息
'**********************************************************************
'----------------------------------------------------------------------
'----------------------------------------------------------------------
'文件上传类
Class UpFile_Class

Dim Form,File
Dim AllowExt_    '允许上传类型(白名单)
Dim NoAllowExt_    '不允许上传类型(黑名单)
Dim IsDebug_ '是否显示出错信息
Private    oUpFileStream    '上传的数据流
Private isErr_        '错误的代码,0或true表示无错
Private ErrMessage_    '错误的字符串信息
Private isGetData_    '指示是否已执行过GETDATA过程

'------------------------------------------------------------------
'类的属性
Public Property Get Version
    Version="无惧上传类 Version V2.0"
End Property

Public Property Get isErr        '错误的代码,0或true表示无错
    isErr=isErr_
End Property

Public Property Get ErrMessage        '错误的字符串信息
    ErrMessage=ErrMessage_
End Property

Public Property Get AllowExt        '允许上传类型(白名单)
    AllowExt=AllowExt_
End Property

Public Property Let AllowExt(Value)    '允许上传类型(白名单)
    AllowExt_=LCase(Value)
End Property

Public Property Get NoAllowExt        '不允许上传类型(黑名单)
    NoAllowExt=NoAllowExt_
End Property

Public Property Let NoAllowExt(Value)    '不允许上传类型(黑名单)
    NoAllowExt_=LCase(Value)
End Property

Public Property Let IsDebug(Value)    '是否设置为调试模式
    IsDebug_=Value
End Property


'----------------------------------------------------------------
'类实现代码

'初始化类
Private Sub Class_Initialize
    isErr_ = 0
    NoAllowExt=""        '黑名单,可以在这里预设不可上传的文件类型,以文件的后缀名来判断,不分大小写,每个每缀名用;号分开,如果黑名单为空,则判断白名单
    NoAllowExt=LCase(NoAllowExt)
    AllowExt=""        '白名单,可以在这里预设可上传的文件类型,以文件的后缀名来判断,不分大小写,每个后缀名用;号分开
    AllowExt=LCase(AllowExt)
    isGetData_=false
End Sub

'类结束
Private Sub Class_Terminate   
    on error Resume Next
    '清除变量及对像
    Form.RemoveAll
    Set Form = Nothing
    File.RemoveAll
    Set File = Nothing
    oUpFileStream.Close
    Set oUpFileStream = Nothing
    if Err.number<>0 then OutErr("清除类时发生错误!")
End Sub

'分析上传的数据
Public Sub GetData (MaxSize)
     '定义变量
    on error Resume Next
    if isGetData_=false then
        Dim RequestBinDate,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo
        Dim sFormValue,sFileName
        Dim iFindStart,iFindEnd
        Dim iFormStart,iFormEnd,sFormName
        '代码开始
        If Request.TotalBytes < 1 Then    '如果没有数据上传
            isErr_ = 1
            ErrMessage_="没有数据上传,这是因为直接提交网址所产生的错误!"
            OutErr("没有数据上传,这是因为直接提交网址所产生的错误!!")
            Exit Sub
        End If
        If MaxSize > 0 Then '如果限制大小
            If Request.TotalBytes > MaxSize Then
            isErr_ = 2    '如果上传的数据超出限制大小
            ErrMessage_="上传的数据超出限制大小!"
            OutErr("上传的数据超出限制大小!")
            Exit Sub
            End If
        End If
        Set Form = Server.CreateObject ("Scripting.Dictionary")
        Form.CompareMode = 1
        Set File = Server.CreateObject ("Scripting.Dictionary")
        File.CompareMode = 1
        Set tStream = Server.CreateObject ("ADODB.Stream")
        Set oUpFileStream = Server.CreateObject ("ADODB.Stream")
        if Err.number<>0 then OutErr("创建流对象(ADODB.STREAM)时出错,可能系统不支持或没有开通该组件")
        oUpFileStream.Type = 1
        oUpFileStream.Mode = 3
        oUpFileStream.Open
        oUpFileStream.Write Request.BinaryRead (Request.TotalBytes)
        oUpFileStream.Position = 0
        RequestBinDate = oUpFileStream.Read
        iFormEnd = oUpFileStream.Size
        bCrLf = ChrB (13) & ChrB (10)
        '取得每个项目之间的分隔符
        sSpace = MidB (RequestBinDate,1, InStrB (1,RequestBinDate,bCrLf)-1)
        iStart = LenB(sSpace)
        iFormStart = iStart+2
        '分解项目
        Do
            iInfoEnd = InStrB (iFormStart,RequestBinDate,bCrLf & bCrLf)+3
            tStream.Type = 1
            tStream.Mode = 3
            tStream.Open
            oUpFileStream.Position = iFormStart
            oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart
            tStream.Position = 0
            tStream.Type = 2
            tStream.CharSet = "gb2312"
            sInfo = tStream.ReadText           
            '取得表单项目名称
            iFormStart = InStrB (iInfoEnd,RequestBinDate,sSpace)-1
            iFindStart = InStr (22,sInfo,"name=""",1)+6
            iFindEnd = InStr (iFindStart,sInfo,"""",1)
            sFormName = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
            '如果是文件
            If InStr (45,sInfo,"filename=""",1) > 0 Then
                Set oFileInfo = new FileInfo_Class
                '取得文件属性
                iFindStart = InStr (iFindEnd,sInfo,"filename=""",1)+10
                iFindEnd = InStr (iFindStart,sInfo,""""&vbCrLf,1)
                sFileName = Trim(Mid(sinfo,iFindStart,iFindEnd-iFindStart))
                oFileInfo.FileName = GetFileName(sFileName)
                oFileInfo.FilePath = GetFilePath(sFileName)
                oFileInfo.FileExt = GetFileExt(sFileName)
                iFindStart = InStr (iFindEnd,sInfo,"Content-Type: ",1)+14
                iFindEnd = InStr (iFindStart,sInfo,vbCr)
                oFileInfo.FileMIME = Mid(sinfo,iFindStart,iFindEnd-iFindStart)
                oFileInfo.FileStart = iInfoEnd
                oFileInfo.FileSize = iFormStart -iInfoEnd -2
                oFileInfo.FormName = sFormName
                file.add sFormName,oFileInfo
            else
            '如果是表单项目
                tStream.Close
                tStream.Type = 1
                tStream.Mode = 3
                tStream.Open
                oUpFileStream.Position = iInfoEnd
                oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2
                tStream.Position = 0
                tStream.Type = 2
                tStream.CharSet = "gb2312"
                sFormValue = tStream.ReadText
                If Form.Exists (sFormName) Then
                    Form (sFormName) = Form (sFormName) & ", " & sFormValue
                    else
                    Form.Add sFormName,sFormValue
                End If
            End If
            tStream.Close
            iFormStart = iFormStart+iStart+2
            '如果到文件尾了就退出
        Loop Until (iFormStart+2) >= iFormEnd
        if Err.number<>0 then OutErr("分解上传数据时发生错误,可能客户端的上传数据不正确或不符合上传数据规则")
        RequestBinDate = ""
        Set tStream = Nothing
        isGetData_=true
    end if
End Sub

'保存到文件,自动覆盖已存在的同名文件
Public Function SaveToFile(Item,Path)
    SaveToFile=SaveToFileEx(Item,Path,True)
End Function

'保存到文件,自动设置文件名
Public Function AutoSave(Item,Path)
    AutoSave=SaveToFileEx(Item,Path,false)
End Function

'保存到文件,OVER为真时,自动覆盖已存在的同名文件,否则自动把文件改名保存
Private Function SaveToFileEx(Item,Path,Over)
    On Error Resume Next
    Dim FileExt
    if file.Exists(Item) then
        Dim oFileStream
        Dim tmpPath
        isErr_=0
        Set oFileStream = CreateObject ("ADODB.Stream")
        oFileStream.Type = 1
        oFileStream.Mode = 3
        oFileStream.Open
        oUpFileStream.Position = File(Item).FileStart
        oUpFileStream.CopyTo oFileStream,File(Item).FileSize
        tmpPath=Split(Path,".")(0)
        FileExt=GetFileExt(Path)
        if Over then
            if isAllowExt(FileExt) then
                oFileStream.SaveToFile tmpPath & "." & FileExt,2
                if Err.number<>0 then OutErr("保存文件时出错,请检查路径,是否存在该上传目录!该文件保存路径为" & tmpPath & "." & FileExt)
                Else
                isErr_=3
                ErrMessage_="该后缀名的文件不允许上传!"
                OutErr("该后缀名的文件不允许上传")
            End if
            Else
            Path=GetFilePath(Path)
            dim fori
            fori=1
            if isAllowExt(File(Item).FileExt) then
                do
                    fori=fori+1
                    Err.Clear()
                    tmpPath=Path&GetNewFileName()&"."&File(Item).FileExt
                    oFileStream.SaveToFile tmpPath
                loop Until ((Err.number=0) or (fori>50))
                if Err.number<>0 then OutErr("自动保存文件出错,已经测试50次不同的文件名来保存,请检查目录是否存在!该文件最后一次保存时全路径为"&Path&GetNewFileName()&"."&File(Item).FileExt)
                Else
                isErr_=3
                ErrMessage_="该后缀名的文件不允许上传!"
                OutErr("该后缀名的文件不允许上传")
            End if
        End if
        oFileStream.Close
        Set oFileStream = Nothing
    else
        ErrMessage_="不存在该对象(如该文件没有上传,文件为空)!"
        OutErr("不存在该对象(如该文件没有上传,文件为空)")
    end if
    if isErr_=3 then SaveToFileEx="" else SaveToFileEx=GetFileName(tmpPath)
End Function

'取得文件数据
Public Function FileData(Item)
    isErr_=0
    if file.Exists(Item) then
        if isAllowExt(File(Item).FileExt) then
            oUpFileStream.Position = File(Item).FileStart
            FileData = oUpFileStream.Read (File(Item).FileSize)
            Else
            isErr_=3
            ErrMessage_="该后缀名的文件不允许上传"
            OutErr("该后缀名的文件不允许上传")
            FileData=""
        End if
    else
        ErrMessage_="不存在该对象(如该文件没有上传,文件为空)!"
        OutErr("不存在该对象(如该文件没有上传,文件为空)")
    end if
End Function


'取得文件路径
Public function GetFilePath(FullPath)
  If FullPath <> "" Then
    GetFilePath = Left(FullPath,InStrRev(FullPath, "/"))
    Else
    GetFilePath = ""
  End If
End function

'取得文件名
Public Function GetFileName(FullPath)
  If FullPath <> "" Then
    GetFileName = mid(FullPath,InStrRev(FullPath, "/")+1)
    Else
    GetFileName = ""
  End If
End function

'取得文件的后缀名
Public Function GetFileExt(FullPath)
  If FullPath <> "" Then
    GetFileExt = LCase(Mid(FullPath,InStrRev(FullPath, ".")+1))
    Else
    GetFileExt = ""
  End If
End function

'取得一个不重复的序号
Public Function GetNewFileName()
    dim ranNum
    dim dtNow
    dtNow=Now()
    randomize
    ranNum=int(90000*rnd)+10000
    '以下这段由webboy提供
    GetNewFileName=year(dtNow) & right("0" & month(dtNow),2) & right("0" & day(dtNow),2) & right("0" & hour(dtNow),2) & right("0" & minute(dtNow),2) & right("0" & second(dtNow),2) & ranNum
End Function

Public Function isAllowExt(Ext)
    if NoAllowExt="" then
        isAllowExt=cbool(InStr(1,";"&AllowExt&";",LCase(";"&Ext&";")))
        else
        isAllowExt=not CBool(InStr(1,";"&NoAllowExt&";",LCase(";"&Ext&";")))
    end if
End Function
End Class

Public Sub OutErr(ErrMsg)
if IsDebug_=true then
    Response.Write ErrMsg
    Response.End
    End if
End Sub

'----------------------------------------------------------------------------------------------------
'文件属性类
Class FileInfo_Class
Dim FormName,FileName,FilePath,FileSize,FileMIME,FileStart,FileExt
End Class
%>
---------------------------------------------

UpFile_Class 概述
	自从用ASP来编写网站，就无时无刻想找一种兼容性强，使用方便的上传方法，用过很多的无 组件上传方法，但是都存在使用不方便，兼容性差，速度慢等的问题。终于在2003年的元旦里，想 到了可以让上传文件达到最快的方法，经过10天的努力，整整10个版本的版本的更新，终于完成了第一个“无惧上传类V1.0”，这个版本与其它的上传类或方法相比，具有速度快，兼容性强， 使用方便等特点。 经过整整一年,在得到各大网友的支持下,并且在长期使用中针对该版的不足,开发了1.1,1.2等版本,由于为了向下兼容,放弃了很多新的特性,现在,结过审慎考虑,终于在2004年7月10日完成了"无惧上传类2.0"版,该版相对于前作在安全上作出了最大的改进,在类内部实现了上传类型的黑白名单,更多方便了各种上传的环境,即使黑客突破了上传程序,但是最终在保存文件时会使他的所有努力付之流水,该版在使用上比前作更加方便,更人性化了。由于添加和修改了不少属性值,在移植上需要作出比较大的修改。
UpFile_Class 公共属性
	File 文件域的集合,是一个Dictionary 对象,返回值一个FileInfo_Class 类。可读写。 Form 表单域的集合,是一个Dictionary 对象,返回对应表单域的值。可读写。 isErr 返回错误的数值。-1表示无错,1表示没有上传数据,2表示上传超出限制。只读。 Version 获取类的版本信息。只读。 AllowExt 白名单，允许上传的文件类型，可以在类文件里预设可上传的文件类型,以文件的后缀名来判断,不区分大小写,每个后缀名用“;”号分开。如AllowExt="jpg;rar;zip"。可读写。 NoAllowExt 黑名单，不允许上传的文件类型，可以在类文件里预设不可上传的文件类型,以文件的后缀名来判断,不区分大小写,每个后缀名用“;”号分开。如NoAllowExt="asp;htm;html;js;"。可读写 ErrMessage 错误信息，在发生错误时，可以调用ErrMessage显示错误的字符串信息。只读。
UpFile_Class 公共方法
	GetData(MaxSize As Int64) 分析上传的数据。MaxSize为限制上传的字节,设为-1即不限制大小，此为过程，没有返回值，调用后调检查isErr是否大于0。 SaveToFile(Item As String,Path As String) 保存到文件,自动覆盖已存在的同名文件，Item为表单项名，Path为保存的绝对路径，返回值为保存的文件名。 AutoSave(Item As String,Path As String) 保存到文件,自动创建文件名以避免重复，Item为表单的名，Path为保存的绝对路径（可不包含文件名，如e:/wwwroot/upimg/),返回值为保存的文件名。 FileData(Item As String) 取得文件数据，Item为表单项名 GetFilePath(FullPath As String) 返回文件在路径，如GetFilePath("c:/a.asp") 返回值为"c:/"。 GetFileName(FullPath As String) 返回文件名，如GetFileName("c:/a.asp") 返回值为"a.asp"。 GetFileExt(FullPath As String) 返回文件的后缀名，如GetFileExt("c:/a.asp") 返回值为"asp"。 GetNewFileName() 返回一个以时间种子的不重复数值，可以用作文件名。 isAllowExt(Ext As String) 返回一个真假值指是Ext是否为可上传的类型,如isAllowExt("jpg")。
UpFile_Class 受保护方法
	SaveToFileEx(Item As String,Path As String,Over As bool) 保存到文件，其中Over指示如果文件存在是否覆盖，如果OVER为真时，文件按PATH来保存，如果OVER为假，则自动调用 GetNewFileName() 生成一个新的不重复的文件名，以上传时的后缀名保存。
FileInfo_Class 概述
	文件信息类,用来存贮上传的文件信息
FileInfo_Class 公共属性
	FileName 返回上传的文件名。 FilePath 返回上传时文件在客户端的路径。 FileExt 返回文件扩展名。 FileMIME 返回文件MIME类别。 FileSize 返回文件大小(以字节为单位)。

使 用 示 例

上传文件的表单要加入enctype="multipart/form-data"属性，即 <form name="form1" method="post" action="" enctype="multipart/form-data"> <input type="text" value="1" name="name"> <input type=file name="img"> <input type=submit name="submit" value="提交"> </form> 在执行上传的ASP页 '包含类文件 <!-- #include file="upfile_class.asp" --> dim upfile dim SaveFilename '建立上传对象 set upfile=new upfile_class '取得上传数据,限制最大上传10M 计算方法为 10240000/1000000=10.24M upfile.GetData (10240000) '判决是否出错 if upfile.isErr then   select case upfile.err     case 1       Response.Write "你没有上传数据呀???是不是搞错了??"     case 2       Response.Write "你上传的文件超出我们的限制,最大10M"   end select   else   '执行保存文件代码    upfile.SaveToFile "img","c:/"&upfile.file("img").filename   '执行自动保存文件代码，SaveFilename为保存的文件名    SaveFilename=upfile.AutoSave("img","c:/")    '销毁对像   set upfile=nothing end if

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>