写了几个类，希望对大家有用。

[Ctrl+A 全选注:[url=http://www.1sucai.cn/article/23421.htm]如需引入外部Js需刷新才能执行[/url]]

<% 
    Class Upload 
        Public  Form, Finished 
        Private bVBCrlf, bSeparate, formData, cFields, folderPath, itemCount, sErrors, sAuthor, sVersion 
        Private itemStart(), itemLength(), dataStart(), dataLength(), itemName(), itemData(), extenArr()

Private Sub Class_Initialize       
            formData = Request.BinaryRead(Request.TotalBytes) 
            Set Form = Server.CreateObject("Scripting.Dictionary") 
            sAuthor = "51JS.COM-ZMM" 
            sVersion = "Upload Class 1.0" 
        End Sub  
         
        Public Property Get ErrMessage 
            ErrMessage = sErrors 
        End Property 
  
        Public Property Get Author 
            Author = sAuthor 
        End Property

Public Property Get Version 
            Version = sVersion 
        End Property

Public Property Let CheckFields(byVal sCheck) 
            cFields = sCheck 
        End Property

Public Property Let Folder(byVal sFolder) 
            folderPath = sFolder 
        End Property

Public Function Start 
            Finished = False 
            bVBCrlf = StrToByte(vbCrlf & vbCrlf) 
            bSeparate = StrToByte("-----------------------------") 
            itemCount = 0 
            sErrors = "" 
            Call ItemPosition  
        End Function

Private Function ItemPosition 
            Dim iStart, iLength : iStart = 1         
            Do Until InStrB(iStart, formData, bSeparate) = 0 
               iStart = InStrB(iStart, formData, bSeparate) + LenB(bSeparate) + 14 
               iLength = InStrB(iStart, formData, bSeparate) - iStart - 2 
               If Abs(iStart + 2 - LenB(formData)) > 2 Then 
                  ReDim Preserve itemStart(itemCount) 
                  ReDim Preserve itemLength(itemCount) 
                  itemStart(itemCount) = iStart 
                  itemLength(itemCount) = iLength 
                  itemCount = itemCount + 1 
               End If 
            Loop 
            Call FillItemValue 
        End Function

Private Function FillItemValue 
            Dim dataPart, bInfor 
            Dim iStart : iStart = 1 
            Dim iCount : iCount = 0 
            Dim iCheck : iCheck = StrToByte("filename") 
            For i = 0 To itemCount - 1 
                ReDim Preserve itemName(iCount) 
                ReDim Preserve itemData(iCount) 
                ReDim Preserve extenArr(iCount) 
                ReDim Preserve dataStart(iCount) 
                ReDim Preserve dataLength(iCount) 
                dataPart = MidB(formData, itemStart(i), itemLength(i)) 
                iStart = InStrB(1, dataPart, ChrB(34)) + 1 
                iLength = InStrB(iStart, dataPart, ChrB(34)) - iStart 
                itemName(iCount) = FormItemName(MidB(dataPart, iStart, iLength)) 
                iStart = InStrB(1, dataPart, bVBCrlf) + 4 
                iLength = LenB(dataPart) - iStart + 1 
                If InStrB(1, dataPart, iCheck) > 0 Then 
                   bInfor = MidB(dataPart, 1, iStart - 5) 
                   extenArr(iCount) = FileExtenName(bInfor) 
                   If Mid(folderPath, Len(folderPath) - 1) = "/" Then 
                      itemData(iCount) = folderPath & GetRndName(6) & extenArr(iCount) 
                   Else 
                      itemData(iCount) = folderPath & "/" & GetRndName(6) & extenArr(iCount)   
                   End If 
                   dataStart(iCount) = itemStart(i) + iStart - 2 
                   dataLength(iCount) = iLength 
                Else 
                   extenArr(iCount) = "" 
                   itemData(iCount) = ByteToStr(MidB(dataPart, iStart, iLength)) 
                   dataStart(iCount) = "" 
                   dataLength(iCount) = "" 
                End If 
                iCount = iCount + 1 
            Next 
            Call SaveUpload 
        End Function

Private Function FormItemName(byVal bName) 
            FormItemName = ByteToStr(bName) 
        End Function

Private Function FileExtenName(byVal bInfor) 
            Dim pStart, pLength, pContent, regEx 
            pStart = InStr(1, ByteToStr(bInfor), "filename=" & Chr(34)) + 10 
            pLength = InStr(pStart, ByteToStr(bInfor), Chr(34)) - pStart 
            pContent = Mid(ByteToStr(bInfor), pStart, pLength) 
            If pContent = "" Then 
               FileExtenName = "" 
            Else 
               Set regEx = New RegExp 
               regEx.Pattern = "^.*(\.[^\.]*)$" 
               regEx.Global = False 
               regEx.IgnoreCase = True 
               FileExtenName = regEx.Replace(pContent, "$1") 
               Set regEx = Nothing                 
            End If         
        End Function

Private Function GetRndName(byVal sLen) 
            Dim regEx, sTemp, arrFields, n : n = 0 
            Set regEx = New RegExp 
            regEx.Pattern = "[^\d]*" 
            regEx.Global = True 
            regEx.IgnoreCase = True 
            sTemp = regEx.Replace(Now, "") & "-" 
            Set regEx = Nothing          
            arrFields = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", _  
                              "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", _  
                              "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", _ 
                              "u", "v", "w", "x", "y", "z", "A", "B", "C", "D", _ 
                              "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", _ 
                              "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", _ 
                              "Y", "Z") 
            Randomize 
            Do While n < sLen 
               sTemp = sTemp & CStr(arrFields(61 * Rnd)) 
               n = n + 1 
            Loop 
            GetRndName = sTemp 
        End Function

Private Function SaveUpload 
            Dim isValidate 
            Dim filePath, oStreamGet, oStreamPut 
            isValidate = CheckFile 
            If isValidate Then 
               For i = 0 To itemCount - 1 
                   If (dataStart(i) <> "") And (dataLength(i) <> "") Then 
                       If dataLength(i) = 0 Then 
                          itemData(i) = ""  
                       Else 
                          filePath = Server.MapPath(itemData(i)) 
                          If CreateFolder("|", ParentFolder(filePath)) Then                           
                             Set oStreamGet = Server.CreateObject("ADODB.Stream") 
                             oStreamGet.Type = 1 
                             oStreamGet.Mode = 3 
                             oStreamGet.Open 
                             oStreamGet.Write formData 
                             oStreamGet.Position = dataStart(i) 
                             Set oStreamPut = Server.CreateObject("ADODB.Stream") 
                             oStreamPut.Type = 1 
                             oStreamPut.Mode = 3 
                             oStreamPut.Open 
                             oStreamPut.Write oStreamGet.Read(dataLength(i)) 
                             oStreamPut.SaveToFile(filePath) 
                             oStreamGet.Close 
                             Set oStreamGet = Nothing 
                             oStreamPut.Close 
                             Set oStreamPut = Nothing 
                          End If   
                       End If                    
                   End If 
               Next 
               Finished = True 
               Call ItemToColl 
            Else                
               Finished = False 
            End If 
        End Function

Private Function CheckFile 
            Dim oBoolean : oBoolean = True 
            If cFields = "" Then 
               oBoolean = oBoolean And True 
            Else 
               For i = 0 To itemCount - 1 
                   If extenArr(i) <> "" Then 
                      If InStr(1, Ucase(cFields), "|" & Ucase(Mid(extenArr(i), 2)) & "|") > 0 Then 
                         oBoolean = oBoolean And True 
                      Else 
                         sErrors = sErrors & "表单[ " & itemName(i) & " ]的文件格式错误！\n" & _ 
                                             "支持的格式为：" & Replace(Mid(cFields, 2, Len(cFields) - 1), "|", " ") & "\n\n" 
                         oBoolean = oBoolean And False      
                      End If 
                   End If  
               Next 
            End If 
            CheckFile = oBoolean 
        End Function

Private Function CreateFolder(byVal sLine, byVal sPath) 
            Dim oFso 
            Set oFso = Server.CreateObject("Scripting.FileSystemObject") 
            If Not oFso.FolderExists(sPath) Then 
               Dim regEx 
               Set regEx = New RegExp 
               regEx.Pattern = "^(.*)\\([^\\]*)$" 
               regEx.Global = False 
               regEx.IgnoreCase = True    
               sLine = sLine & regEx.Replace(sPath, "$2") & "|" 
               sPath = regEx.Replace(sPath, "$1")      
               If CreateFolder(sLine, sPath) Then CreateFolder = True  
               Set regEx = Nothing 
            Else 
               If sLine = "|" Then 
                  CreateFolder = True 
               Else 
                  Dim sTemp : sTemp = Mid(sLine, 2, Len(sLine) - 2) 
                  If InStrRev(sTemp, "|") = 0 Then 
                     sLine = "|" 
                     sPath = sPath & "\" & sTemp              
                  Else 
                     Dim Folder : Folder = Mid(sTemp, InStrRev(sTemp, "|") + 1) 
                     sLine = "|" & Mid(sTemp, 1, InStrRev(sTemp, "|") - 1) & "|" 
                     sPath = sPath & "\" & Folder 
                  End If 
                  oFso.CreateFolder sPath 
                  If CreateFolder(sLine, sPath) Then CreateFolder = True              
               End if 
            End If 
            Set oFso = Nothing   
        End Function

Function ParentFolder(byVal sPath) 
            Dim regEx 
            Set regEx = New RegExp 
            regEx.Pattern = "^(.*)\\[^\\]*$" 
            regEx.Global = True 
            regEx.IgnoreCase = True 
            ParentFolder = regEx.Replace(sPath, "$1") 
            Set regEx = Nothing              
        End Function

Private Function StrToByte(byVal sText)  
            For i = 1 To Len(sText)               
                StrToByte = StrToByte & ChrB(Asc(Mid(sText, i, 1)))    
            Next 
        End Function

Private Function ByteToStr(byVal sByte) 
            Dim oStream 
            Set oStream = Server.CreateObject("ADODB.Stream") 
            oStream.Type = 2 
            oStream.Mode = 3 
            oStream.Open 
            oStream.WriteText sByte 
            oStream.Position = 0 
            oStream.CharSet = "gb2312" 
            oStream.Position = 2 
            ByteToStr = oStream.ReadText 
            oStream.Close  
            Set oStream = Nothing          
        End Function

Private Function ItemToColl 
            For i = 0 To itemCount - 1 
                If Not Form.Exists(itemName(i)) Then 
                   Form.Add itemName(i), itemData(i) 
                End If 
            Next 
        End Function

Private Sub Class_Terminate 
            Form.RemoveAll 
            Set Form = Nothing 
        End Sub 
    End Class

If Request.ServerVariables("REQUEST_METHOD") = "POST" Then 
       Rem 建立上传类实例        
       Set oUpload = New Upload 
       Rem 指定允许上传文件的类型 
       oUpload.CheckFields = "|GIF|BMP|JPG|" 
       Rem 指定上传文件所存储的相对路径 
       oUpload.Folder = "51JS.COM-ZMM/UploadFile" 
       Rem 开始上传处理 
       oUpload.Start 
       If oUpload.Finished Then 
          Rem 上传成功，显示上传信息 
          Dim sHtml : sHtml = "" 
          sHtml = sHtml & "[center]" 
          sHtml = sHtml & "<div align="" auto="auto" border="border" font-size="font-size" height="height" highlight="highlight" left="left" overflow="overflow" pt="pt" px="px" solid="solid" style="" width="width">" 
          sHtml = sHtml & "<center color="color" font-size="font-size" pt="pt" red="red" style="">上传表单数据[/center]
" 
          sHtml = sHtml & "标题：
" & oUpload.Form("P_title") & "

" 
          sHtml = sHtml & "类型：
" & oUpload.Form("P_assort") & "

" 
          sHtml = sHtml & "小图：
服务器端路径：[url=http://www.1sucai.cn/article/5342.htm]" & oUpload.Form("P_image_s") & "[/url]
[img]http://www.1sucai.cn/article/5342.htm[/img]

" 
          sHtml = sHtml & "中图：
服务器端路径：[url=http://www.1sucai.cn/article/5342.htm]" & oUpload.Form("P_image_m") & "[/url]
[img]http://www.1sucai.cn/article/5342.htm[/img]

" 
          sHtml = sHtml & "大图：
服务器端路径：[url=http://www.1sucai.cn/article/5342.htm]" & oUpload.Form("P_image_b") & "[/url]
[img]http://www.1sucai.cn/article/5342.htm[/img]

" 
          sHtml = sHtml & "介绍：
" & oUpload.Form("P_content") & "
"                    
          sHtml = sHtml & "</div>" 
          sHtml = sHtml & "</center>" 
          Response.Write sHtml 
          Response.End 
       Else 
          Rem 上传失败，显示错误信息 
          Call ShowMsg(oUpload.ErrMessage, Request.ServerVariables("SCRIPT_NAME")) 
       End If 
       Rem 对话框提示函数 
       Function ShowMsg(byVal sText, byVal sTarget) 
           Dim sScript : sScript = "" 
           sScript = sScript & "" 
           Response.Write sScript 
           Response.End 
       End Function           
    End If 
%>

多文件、表单混合上传类 
<meta content="text/html; charset=gb2312" http-equiv="Content-Type">

[Ctrl+A 全选注:[url=http://www.1sucai.cn/article/23421.htm]如需引入外部Js需刷新才能执行[/url]]

上传功能测试
标题：
类型：
小图：
中图：
大图：
介绍：
</textarea>