ASP多文件无组件上传

用了别人的类,挺不错的程序
需要的可以改改 通过遍历数据可以实现无组件上传多文件
对于访问量不大的中小站很有用 对于不能安装组件的虚拟主机就更有效了。。。

我发现这个类很强大
提取表单数据、上传到不同文件夹、保存到数据库(上传和保存表单可同时进行)、限制上传扩展名、限制上传大小、选择文件保存类型

具体如下

adm_upload.asp文件内容如下


    <html>
    <head>
    <meta http-equiv="Content-Type" content="text/html; charset=gb2312">
    <LINK href="../css.css" type=text/css rel=stylesheet>
    <style type="text/css">
    <!--
    BODY{
    BACKGROUND-COLOR: #FFFFFF;
    font-size:9pt
    }
    .tx1 { height: 20px;font-size: 9pt; border: 1px solid; border-color: #000000; color: #0000FF}
    -->
    </style>
    
    <SCRIPT language=javascript>
    function check() 
    {
      var strFileName=form1.FileName.value;
      var FileType;
      if (strFileName=="")
      {
          alert("请选择要上传的文件");
          return false;
        }
    }
    </SCRIPT>
    </head>
    <body bgcolor="#FFFFFF" leftmargin="0" topmargin="0">
    <%
    dim fpath:fpath=request("fpath")
    %>
    <form action="adm_upfile.asp" method="post" name="form1" onSubmit="return check()" target="_self" enctype="multipart/form-data">
      <TABLE  border="0" cellpadding="0" cellspacing="0" bordercolor="#999999"  id="parts" width="500"> </TABLE> 
    </td> 
          </tr> 
          <tr> 
            <td colspan="2"> <input name="Submit" type="button" class="btbg"  onclick="javascript:Addparts()" value="增加文件" /> </td> 
          </tr> 
          <tr> 
            <td colspan="2"> <div align="center"> 
                 
                  
                  文件1:<input class="iFile" id="file1" type="file" name="file1" size="40" /><br />
    <input name="SUBMIT" type=SUBMIT class="btbg" value="上 传"  /> 
    
    </div> </td> 
          </tr> 
        </table> 
      
    </form>
    </body><script>  
      function  Addparts()  
      { 
    
      var  row  =  parts.insertRow(parts.rows.length);//id=recordTable    
      var  col  =  row.insertCell(0);  
      var  i  =  row.rowIndex+2; 
    
      col.innerHTML  =  "文件"+ i + " <input  type='file'  name='file"+  i  +  "'  value=''  style='width:300px; margin-left:5px; margin-right:40px; text-align:center;' onpropertychange='checkFile(this)'>";  
      col  =  row.insertCell(1);    
       col  =  row.insertCell(2);    
      
      } 
    function checkFile(obj){ 
              var oExten = obj.value.replace(/^.*\.([^\.]*)$/, '$1').toLowerCase(); 
              if(oExten != 'jpg'&& oExten != 'gif'&&oExten!='bmp'&&oExten!='png'&&oExten!='rar'&&oExten!='doc'&&oExten!='xls'&&oExten!='txt'){ 
                obj.outerHTML = obj.outerHTML; 
              } 
      
        } 
    
      </script> 
    </html>

adm_upfile.asp文件内容如下


    <!--#include file="upload_class.asp"-->
    <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
    <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="zh-cn" lang="zh-cn">
    <head>
    <meta http-equiv="Content-Type" content="text/html; charset=gb2312" />
    <title>多文件上传</title>
    <style type="text/css">
    TABLE {border:1px green solid;margin-top:5px;}
    TD{border-bottom:1px #dddddd solid;height:20px;padding:3px 0 0 5px;}
    .head{background-color:#eeeeee;}
    </style>
    </head>
    <body >
    <%
    Dim Upload,successful
    '===============================================================================
    set Upload=new AnUpLoad     '创建类实例
    Upload.SingleSize=1024*1024                  '设置单个文件最大上传限制,按字节计;默认为不限制
    Upload.MaxSize=20*1024*1024                  '设置最大上传限制,按字节计;默认为不限制
    Upload.Exe="rar|jpg|bmp|gif|jepg"                  '设置合法扩展名,以|分割,忽略大小写
    Upload.GetData()            '获取并保存数据,必须调用本方法
    '===============================================================================
    if Upload.Err>0 then            '判断错误号,如果myupload.Err<=0表示正常
      response.write Upload.Description       '如果出现错误,获取错误描述
    else
      if Upload.files(-1).count>0 then         '这里判断是否上传了文件
            path=server.mappath("./")       '文件保存路径  要修改位置的话就修改这里
        for each f in Upload.files(-1)
              set tempCls=Upload.files(f) 
              successful=tempCls.SaveToFile(path,0)    '以时间+随机数字为文件名保存
              'successful=tempCls.SaveToFile(path,1)    '原文件名保存
          if successful then
                response.write tempCls.FileName & "上传完毕" & "!<br />"
          else
            response.write "上传失败"
          end if
              set tempCls=nothing
        next
        response.write "所有文件保存完毕,本次共上传了" & Upload.files(-1).count & "个文件,位置在当前目录"
      end if
    end if
    set Upload=nothing                   '销毁
    %>
    </body>
    </html>

UpLoad_Class.asp文件如下


    <%
    '=========================================================
    '类名: AnUpLoad(艾恩无组件上传类)
    '作者: Anlige
    '版本: An-Upload无组件上传类8.12.20
    '开发日期: 2008-4-12
    '修改日期: 2008-12-20
    '作者主页: http://www.ii-home.cn
    'Email: zhanghuiguoanlige@126.com
    '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.20"
       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
    
    '==============================


「倘若有所帮助,不妨酌情赞赏!」

Holmesian

感谢您的支持!

使用微信扫描二维码完成支付


相关文章

发表新评论