upload_class.asp

本组件是继作者原“艾恩ASP无组件上传类”修改整合而成, 具有和无组件上传类相同的功能,并且具有无组件类不能相比的优越性能。 能实现的功能主要包括:自由提取表单数据、自由限制上传扩展名、自由限制上

<%
'=========================================================
 '类名: UpLoad(艾恩无组件上传类)
 '作者: Anlige
 '版本: An-Upload无组件上传类8.10.20
 '开发日期: 2008-4-12
 '修改日期: 2008-10-20
 '作者主页: http://www.ii-home.cn
 'Email: [e-mail]
 'QQ: 417833272
'=========================================================
Dim StreamT
Class AnUpLoad
 Private Form, Fils
 Private vCharSet, vMaxSize, vSingleSizeg, vErr, vVersion, vTotalSize, vExe, NewName

 '设置和读取属性开始
 Public Property Let MaxSize(ByVal value)
   vMaxSize = value
 End Property
 
 Public Property Let SingleSize(ByVal value)
   vSingleSize = value
 End Property
 
 Public Property Let Exe(ByVal value)
   vExe = LCase(value)
 End Property
 
 Public Property Let CharSet(ByVal value)
   vCharSet = value
 End Property
 
 Public Property Get Err()
   Err = vErr
 End Property
 
 Public Property Get Description()
   Description = GetErr(vErr)
 End Property
 
 Public Property Get Version()
   Version = vVersion
 End Property
 
 Public Property Get TotalSize()
   TotalSize = vTotalSize
 End Property
 
 '设置和读取属性结束

 Private Sub Class_Initialize()
   set StreamT=server.createobject("ADODB.STREAM")
   set Form = server.createobject("Scripting.Dictionary")
   set Fils = server.createobject("Scripting.Dictionary")
   vVersion = "Anlige无组件上传8.12.14"
   vMaxSize = -1
   vSingleSize = -1
   vErr = -1
   vExe = ""
   vTotalSize = 0
   vCharSet = "gb2312"
 End Sub

 Private Sub Class_Terminate()
   Set Form = Nothing
   Set Fils = Nothing
   Set StreamT = Nothing
 End Sub

 '函数名:GetData
 '作用:处理客户端提交来的所有数据
 '参数:客户端提交来的所有数据的二进制形式
 Public Sub GetData()
    Dim value, str, bcrlf, fpos, sSplit, slen, istartg
    Dim formend, formhead, startpos, endpos, formname, FileName, fileExe, valueend, NewName
    If checkEntryType = True Then
        vTotalSize = 0
        StreamT.Type = 1
        StreamT.Mode = 3
        StreamT.Open
        StreamT.Write Request.binaryread(Request.totalbytes)
        StreamT.Position = 0
        tempdata = StreamT.Read
        bcrlf = ChrB(13) & ChrB(10)
        fpos = InStrB(1, tempdata, bcrlf)
        sSplit = MidB(tempdata, 1, fpos - 1)
        slen = LenB(sSplit)
        istart = slen + 2
        Do
            formend = InStrB(istart, tempdata, bcrlf & bcrlf)
            formhead = MidB(tempdata, istart, formend - istart)
            str = Bytes2Str(formhead)
            startpos = InStr(str, "name=""") + 6
            endpos = InStr(startpos, str, """")
            formname = LCase(Mid(str, startpos, endpos - startpos))
            valueend = InStrB(formend + 3, tempdata, sSplit)
            If InStr(str, "filename=""") > 0 Then
                startpos = InStr(str, "filename=""") + 10
                endpos = InStr(startpos, str, """")
                FileName = Mid(str, startpos, endpos - startpos)
                If Trim(FileName) <> "" Then
                    LocalName = FileName
                    FileName = Replace(FileName, "/", "\")
                    FileName = Mid(FileName, InStrRev(FileName, "\") + 1)
                    fileExe = Split(FileName, ".")(UBound(Split(FileName, ".")))
                    If vExe <> "" Then '判断扩展名
                        If checkExe(fileExe) = True Then
                            vErr = 3
                            Exit Sub
                        End If
                    End If
                    NewName = Getname()
                    NewName = NewName & "." & fileExe
                    vTotalSize = vTotalSize + valueend - formend - 6
                    If vSingleSize > 0 And (valueend - formend - 6) > vSingleSize Then '判断上传单个文件大小
                        vErr = 5
                        Exit Sub
                    End If
                    If vMaxSize > 0 And vTotalSize > vMaxSize Then '判断上传数据总大小
                        vErr = 1
                        Exit Sub
                    End If
                    If Fils.Exists(formname) Then
                        vErr = 4
                        Exit Sub
                    Else
                        Dim fileCls
			set fileCls=New fileAction
                        fileCls.Size = (valueend - formend - 6)
                        fileCls.Position = (formend + 3)
                        fileCls.NewName = NewName
                        fileCls.LocalName = FileName
                        Fils.Add formname, fileCls
                        Form.Add formname, LocalName
                        Set fileCls = Nothing
                    End If
                End If
            Else
                value = MidB(tempdata, formend + 4, valueend - formend - 6)
                If Form.Exists(formname) Then
                    Form(formname) = Form(formname) & "," & Bytes2Str(value)
                Else
                    Form.Add formname, Bytes2Str(value)
                End If
            End If
            istart = valueend + 2 + slen
        Loop Until (istart + 2) >= LenB(tempdata)
        vErr = 0
   Else
        vErr = 2
   End If
 End Sub
 
 '判断扩展名
 Private Function checkExe(ByVal ex)
      Dim notIn: notIn = True
      If InStr(1, vExe, "|") > 0 Then
           Dim tempExe: tempExe = Split(vExe, "|")
           Dim I: I = 0
           For I = 0 To UBound(tempExe)
                 If LCase(ex) = tempExe(I) Then
                       notIn = False
                       Exit For
                 End If
           Next
     Else
           If vExe = LCase(ex) Then
                notIn = False
           End If
     End If
     checkExe = notIn
 End Function
 
 '-------------------把数字转换为文件大小显示方式
 Public Function GetSize(ByVal Size)
    If Size < 1024 Then
       GetSize = FormatNumber(Size, 2) & "B"
    ElseIf Size >= 1024 And Size < 1048576 Then
       GetSize = FormatNumber(Size / 1024, 2) & "KB"
    ElseIf Size >= 1048576 Then
       GetSize = FormatNumber((Size / 1024) / 1024, 2) & "MB"
    End If
 End Function

 '-------------------二进制数据转换为字符
 Private Function Bytes2Str(ByVal byt)
    If LenB(byt) = 0 Then
    Bytes2Str = ""
    Exit Function
    End If
    Dim mystream, bstr
    Set mystream =server.createobject("ADODB.Stream")
    mystream.Type = 2
    mystream.Mode = 3
    mystream.Open
    mystream.WriteText byt
    mystream.Position = 0
    mystream.CharSet = vCharSet
    mystream.Position = 2
    bstr = mystream.ReadText()
    mystream.Close
    Set mystream = Nothing
    Bytes2Str = bstr
 End Function

 '-------------------获取错误描述
 Private Function GetErr(ByVal Num)
    Select Case Num
      Case 0
        GetErr = "数据处理完毕!"
      Case 1
        GetErr = "上传数据超过" & GetSize(vMaxSize) & "限制!可设置MaxSize属性来改变限制!"
      Case 2
        GetErr = "未设置上传表单enctype属性为multipart/form-data,上传无效!"
      Case 3
        GetErr = "含有非法扩展名文件!只能上传扩展名为" & Replace(vExe, "|", ",") & "的文件"
      Case 4
        GetErr = "对不起,程序不允许使用相同name属性的文件域!"
      Case 5
        GetErr = "单个文件大小超出" & GetSize(vSingleSize) & "的上传限制!"
    End Select
 End Function

 '-------------------根据日期生成随机文件名
 Private Function Getname()
    Dim y, m, d, h, mm, S, r
    Randomize
    y = Year(Now)
    m = Month(Now): If m < 10 Then m = "0" & m
    d = Day(Now): If d < 10 Then d = "0" & d
    h = Hour(Now): If h < 10 Then h = "0" & h
    mm = Minute(Now): If mm < 10 Then mm = "0" & mm
    S = Second(Now): If S < 10 Then S = "0" & S
    r = 0
    r = CInt(Rnd() * 1000)
    If r < 10 Then r = "00" & r
    If r < 100 And r >= 10 Then r = "0" & r
    Getname = y & m & d & h & mm & S & r
 End Function
 
 '------------------------检测上传类型是否为multipart/form-data
 Private Function checkEntryType()
    Dim ContentType, ctArray, bArray
    ContentType = LCase(Request.ServerVariables("HTTP_CONTENT_TYPE"))
    ctArray = Split(ContentType, ";")
    If Trim(ctArray(0)) = "multipart/form-data" Then
        checkEntryType = True
    Else
        checkEntryType = False
    End If
 End Function
 
 '获取上传表单值,参数可选,如果为-1则返回一个包含所有表单项的一个dictionary对象
 Public Function Forms(ByVal formname)
 If trim(formname) = "-1" Then
        Set Forms = Form
 Else
        If Form.Exists(LCase(formname)) Then
            Forms = Form(LCase(formname))
        Else
            Forms = ""
        End If
 End If
 End Function
 
'获取上传的文件类,参数可选,如果为-1则返回一个包含所有上传文件类的一个dictionary对象
 Public Function Files(ByVal formname)
  If trim(formname) = "-1" Then
        Set Files = Fils
 Else
        If Fils.Exists(LCase(formname)) Then
            Set Files = Fils(LCase(formname))
        Else
            Set Files = Nothing
        End If
 End If
 End Function
End Class


Class fileAction
   Private vSize, vPosition, vName, vNewName, vLocalName, vPath, saveName
   
   '设置属性
   Public Property Let NewName(ByVal value)
          vNewName = value
          vName = value
   End Property

   Public Property Let LocalName(ByVal value)
          vLocalName = value
   End Property

   Public Property Get FileName()
          FileName = vName
   End Property

   Public Property Let Position(ByVal value)
          vPosition = value
   End Property

   Public Property Let Size(ByVal value)
          vSize = value
   End Property
   Public Property Get Size()
          Size = vSize
   End Property
   
   '函数名:SaveToFile
   '作用:根据参数保存文件到服务器
   '参数:参数1--文件保存的路径
   '     参数2--文件保存的方式,有两个可选项0表示以新名字(时间+随机数)为文件名保存,1表示以原文件名保存文件
   Public Function SaveToFile(ByVal path, ByVal saveType)
    'On Error Resume Next
    Err.Clear
    vPath = Replace(path, "/", "\")
    If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
    Dim mystream
    Set mystream =server.createobject("ADODB.Stream")
    mystream.Type = 1
    mystream.Mode = 3
    mystream.Open
    StreamT.Position = vPosition
    StreamT.CopyTo mystream, vSize
    vName = vNewName
    If saveType = 1 Then vName = vLocalName
    mystream.SaveToFile vPath & vName, 2
    mystream.Close
    Set mystream = Nothing
    If Err Then
        SaveToFile = False
    Else
        SaveToFile = True
    End If
   End Function

   '函数名:GetBytes
   '作用:获取文件的二进制形式
   '参数:无
   Public Function GetBytes()
    StreamT.Position = vPosition
    GetBytes = StreamT.Read(vSize)
  End Function

End Class
%>