uploadrequest.asp

本房地产网站功能强大

<%
Class FormElement

 ' m_开头，表示类成员变量。
 Private m_dicItems

 Private Sub Class_Initialize()
   Set m_dicItems = Server.CreateObject("Scripting.Dictionary")
 End Sub

 ' set nothing时激发。清理资源
 Private Sub Class_Terminate()
   Set m_dicItems = Nothing
 End Sub

 ' count是咱们这个类的一个只读属性
 Public Property Get Count()
   Count = m_dicItems.Count
 End Property

 ' Value是一个默认属性。目的是得到值
 Public Default Property Get Value()
   Value = Item("")
 End Property

 ' Name是得到文本域名称。就是<input name=xxx>里的xxx
 Public Property Get Name()
   Dim Keys
   Keys = m_dicItems.Keys
   Name = Keys(0)
   Name = left(Name,instrrev(Name,"_")-1)
 End Property

 ' Item属性用来得到重名表单域（比如checkbox）的某一个值
 Public Property Get Item(index)
   Dim Items, i
   If isNumeric(index) Then '是数字，合法！
     If index > m_dicItems.Count-1 Then
       err.raise 11,"IndexOutOfBound", "表单元素子集索引越界"
     End If
     Items = m_dicItems.Items
     Item = Items(index)
   ElseIf index = "" Then '没给值？那就返回所有的！逗号分隔
     Items = m_dicItems.Items
     For i = 0 to m_dicItems.Count-1
       If i = 0 Then
         Item = Items(0)
       Else
         Item = Item & "," & Items(i)
       End If
     Next
   Else '给个一个不是数字的东东？出错！
     err.raise 12,"IllegalArgument", "非法的表单元素子集索引"
   End If
 End Property

 Public Sub Add(key, item)
   m_dicItems.Add key, item
 End Sub

End Class

'=========================================================================
'' 这个，是存储文件域信息的的类。每一个name的文件，对应一个这样的类。
'=========================================================================
Class FileElement

 ' m_开头，表示类成员变量。
 Private m_strName
 Private m_bData
 Private m_bRawData
 Private m_strContentType
 Private m_strFilePath
 Private m_strFileName
 Private m_lSize

 ' Data是一个默认属性。目的是得到值
 Public Default Property Get Data()
   Data = m_bData
 End Property

 ' 这个属性很尴尬——stream对象write方法要求的数据类型是
 ' "A Variant that contains an array of bytes to be written."
 ' 但是我却无法从一个二进制串中得到这个数据类型！的确很奇怪。所以，我打算
 ' 使用符合要求的原始数据m_bRawData。但是，vbs的类功能少得可怜，既不能传递
 ' 当前对象的引用来回访UploadRequest的m_bRawData也不能用inner class的方
 ' 法进行组织。为了保持方法的简洁，所以加了这个只写的RawData属性。
 ' 这个地方很值得改进。
 Public Property Let RawData(data)
   m_bRawData = data
 End Property

 ' Name是得到文件域名称，就是<input type=file name=xxx>里的xxx
 Public Property Get Name()
   Name = m_strName
 End Property

 ' ContentType是得到文件contentType
 Public Property Get ContentType()
   ContentType = m_strContentType
 End Property

  ' FilePath是得到文件在客户端的路径
 Public Property Get FilePath()
   FilePath = m_strFilePath
 End Property

  ' FilePath是得到文件在客户端的路径
 Public Property Get FileName()
   FileName = m_strFileName
 End Property

  ' Size是得到文件大小
 Public Property Get Size()
   Size = m_lSize
 End Property

 Public Sub Add(name, data, contenttype, path)
   m_strName = name
   m_bData = data
   m_strContentType = contenttype
   m_strFilePath = path
   m_strFileName = right(path, len(path)-instrrev(path, "\"))
   m_lSize = lenb(data)
 End Sub

 Public Sub SaveTo(path)
   Call SaveAs(path, m_strFileName)
 End Sub

 Public Sub SaveAs(path, name)
   Call Save(path, name, True)
 End Sub

 Public Sub SaveWithoutOverwrite(path, name)
   Call Save(path, name, False)
 End Sub

 Private Sub Save(path, name, isOverwrite)
   Dim st, st2
   '这样就可以兼顾c:\xxx\和c:\xxx两种格式了
   If right(path,1) <> "\" Then path = path & "\"
   '用两个stream对象，来截取我们要的内容
   Set st = Server.CreateObject("ADODB.Stream")
   Set st2 = Server.CreateObject("ADODB.Stream")
   st.Type = 1
   st.open
   st2.Type = 1
   st2.open
   st.write m_bRawData
   st.Position = instrb(m_bRawData,m_bData)-1
   st.copyto st2, m_lSize

   If isOverwrite Then '覆盖保存
     st2.SaveToFile path& name,2
   Else '不覆盖
     st2.SaveToFile path& name
   End If

   st.Close
   Set st = Nothing
   st2.Close
   Set st2 = Nothing
 End Sub

End Class

'=========================================================================
'' 这个，是我们模拟的request类。我们用它完成asp的request完成不了的任务 :)
'=========================================================================
Class UploadRequest

 Private m_dicForms
 Private m_dicFiles
 Private m_bRawData
 Private m_lTotalBytes
 Private m_strAllowedFilesList
 Private m_strDeniedFilesList
 Private m_lMaxFileSize
 Private m_lTotalMaxFileSize

 '初始化类成员
 Private Sub Class_Initialize()
   m_lTotalBytes = 0
   m_strAllowedFilesList = ""
   m_strDeniedFilesList = ""
   m_lMaxFileSize = -1
   m_lTotalMaxFileSize = -1
 End Sub

 ' set nothing时激发。清理资源
 Private Sub Class_Terminate()
   ' 这些对象应该有自己的清理方法，咱就不管了
   Set m_dicForms = Nothing
   Set m_dicFiles = Nothing
 End Sub

 Public Sub Upload
   Set m_dicForms = Server.CreateObject("Scripting.Dictionary")
   Set m_dicFiles = Server.CreateObject("Scripting.Dictionary")    
   Call fill()
 End Sub

 '存文件到指定路径
 Public Sub SaveTo(path)
   Dim fElement
   '调用FileElement自己的方法
   For Each fElement In m_dicFiles
     Call m_dicFiles.Item(fElement).SaveTo(path)
   Next
 End Sub

 ' 有了这个，就可以检查原始数据了
 Public Property Get RawData()
   RawData = m_bRawData
 End Property

 ' 这一段丑陋的代码是为了实现ourRequest.Forms.Count这个功能。这个地方值得改进。
 Public Property Get Forms()
   Set Forms = New Counter
   Forms.setCount(m_dicForms.Count)
 End Property

 ' 这一段丑陋的代码是为了实现ourRequest.Files.Count这个功能。这个地方值得改进。
 Public Property Get Files()
   Set Files = New Counter
   Files.setCount(m_dicFiles.Count)
 End Property

 '只读的TotalBytes属性
 Public Property Get TotalBytes()
   TotalBytes = m_lTotalBytes
 End Property

 '只写的AllowedFilesList属性，填入允许类型的扩展名，用|分隔
 Public Property Let AllowedFilesList(afl)
   m_strAllowedFilesList = afl
 End Property

 '只写的DeniedFilesList属性，填入允许类型的扩展名，用|分隔
 Public Property Let DeniedFilesList(dfl)
   m_strDeniedFilesList = dfl
 End Property

 '只写的MaxFileSize属性，填入各个允许上传文件的大小
 Public Property Let MaxFileSize(mfs)
   m_lMaxFileSize = mfs
 End Property

 '只写的TotalMaxFileSize属性，填入允许上传文件的总大小
 Public Property Let TotalMaxFileSize(tmfs)
   m_lTotalMaxFileSize = tmfs
 End Property

 Public Property Get Form(index)
   Dim Items
   If isNumeric(index) Then '是数字？用数字来检索
     If index > m_dicForms.Count-1 Then
       err.raise 21,"IndexOutOfBound", "文本元素索引越界"
     End If
     Items = m_dicForms.Items
     Set Form = Items(index)
   ElseIf VarType(index) = 8 Then '字符串？也行！
     If m_dicForms.Exists(index) Then '存在，就返回值
       Set Form = m_dicForms.Item(index)
     Else '不存在，就给个空值——request对象就是这么做的。
       Exit Property
     End If
   Else '给了一个不是数字也不是字符串的东东？出错！
     err.raise 22,"IllegalArgument", "非法的文本元素索引"
   End If
 End Property

 Public Property Get File(index)
   Dim Items
   If isNumeric(index) Then '是数字？用数字来检索
     If index > m_dicFiles.Count-1 Then
       err.raise 23,"IndexOutOfBound", "文件元素索引越界"
     End If
     Items = m_dicFiles.Items
     Set File = Items(index)
   ElseIf VarType(index) = 8 Then '字符串？也行！
     If m_dicFiles.Exists(index) Then '存在，就返回值
       Set File = m_dicFiles.Item(index)
     Else '不存在，出错！
       err.raise 24,"NullRef", "文件元素索引不存在"
     End If
   Else '给了一个不是数字也不是字符串的东东？出错！
     err.raise 25,"IllegalArgument", "非法的表单元素索引"
   End If
 End Property

 Private Sub fill
   ' 得到数据
   m_bRawData=request.binaryread(request.totalbytes)
   ' 调用这个函数实现递归循环，读取文本/文件单元
   Call fillEveryFirstPart(m_bRawData)
 End Sub

 Private Sub fillEveryFirstPart(data)
   Dim const_nameis, const_filenameis, bncrlf, divider, startpos, endpos
   Dim part1, firstline
   Dim fldname, fldvalue, fElement, filepath, contenttype, ext, afl, dfl
   Dim isTypeError, i

   ' 这就是name="
   const_nameis=chrb(110)&chrb(97)&chrb(109)&chrb(101)&chrb(61)&chrb(34)
   ' 这就是filename="
   const_filenameis=chrb(102)&chrb(105)&chrb(108)&chrb(101)&_
                chrb(110)&chrb(97)&chrb(109)&chrb(101)&chrb(61)&chrb(34)
   ' 这是回车<return>
   bncrlf=chrb(13) & chrb(10)
   ' 得到divider，分隔符
   divider=leftb(data,instrb(data,bncrlf)-1)
   ' 起始位置
   startpos = instrb(data,divider)+lenb(divider)+lenb(bncrlf)
   ' 终止位置，从起始位置开始到下一个divider
   endpos = instrb(startpos, data, divider)-lenb(bncrlf)
   If endpos < 1 Then '没有下一个了！结束！
     Exit Sub
   End If
   part1 = midb(data, startpos, endpos-startpos)
   ' 得到part1的第一行
   firstline = midb(part1, 1, instrb(part1, bncrlf)-1)

   '没有filename="，有name="，说明是一个文本单元
   '（这里有一个BUG，自己研究一下？当作业吧）
   If Not instrb(firstline, const_filenameis) > 0_
      And instrb(firstline, const_nameis) > 0 Then
     ' 得到表单域名称，就是<input type=sometype name=somename>里的somename。
     fldname = B2S(midb(part1,_
               instrb(part1, const_nameis)+lenb(const_nameis),_
               instrb(part1, bncrlf)_
                 -instrb(part1, const_nameis)-lenb(const_nameis)-1))
     ' 得到表单域的值
     fldvalue = B2S(midb(part1,_
                instrb(part1, bncrlf&bncrlf)+lenb(bncrlf&bncrlf),_
                lenb(part1)-instrb(part1, bncrlf&bncrlf)+_
                                   lenb(bncrlf&bncrlf)))
     If m_dicForms.Exists(fldname) Then
       Set fElement = m_dicForms.Item(fldname)
       m_dicForms.Remove fldname
     Else
       Set fElement = new FormElement
     End If

     fElement.Add fldname&"_"&fElement.Count, fldvalue
     m_dicForms.Add fldname, fElement

   '有filename="，有name="，说明是一个文件单元
   '（这里还是有一个BUG，研究出来没？）
   ElseIf instrb(firstline, const_filenameis) > 0_
          And instrb(firstline, const_nameis) > 0 Then
     ' 得到表单域名称，就是<input type=file name=somename>里的somename。
     fldname = B2S(midb(part1,_
               instrb(part1, const_nameis)+lenb(const_nameis),_
               instrb(part1, const_filenameis)_
                 -instrb(part1, const_nameis)-lenb(const_nameis)-3))
     ' 得到表单域的值
     fldvalue = midb(part1,_
                instrb(part1, bncrlf&bncrlf)+lenb(bncrlf&bncrlf),_
                lenb(part1)-instrb(part1, bncrlf&bncrlf)+lenb(bncrlf&bncrlf))
     ' 得到路径
     filepath = B2S(midb(part1,_
               instrb(part1, const_filenameis)+lenb(const_filenameis),_
               instrb(part1, bncrlf)_
                 -instrb(part1, const_filenameis)-lenb(const_filenameis)-1))
     ' 得到contenttype
     contenttype = B2S(midb(part1,_
                   instrb(part1, bncrlf)+lenb(bncrlf)+14,_
                   instrb(part1,_
                          bncrlf&bncrlf)-instrb(part1, bncrlf)-_
                          lenb(bncrlf)-14))
     If lenb(fldvalue) > 0 Then 'size>0说明有文件传来了。
       If m_dicFiles.Exists(fldname) Then
         Set fElement = m_dicFiles.Item(fldname)
         m_dicFiles.Remove fldname
       Else
         Set fElement = new FileElement
         fElement.Rawdata = m_bRawData
       End If

       '检查单个文件尺寸
       If m_lMaxFileSize > 0 And m_lMaxFileSize < lenb(fldvalue) Then _
         err.raise 26,"TooLargeFile", "文件"&fldname&"尺寸过大"
       m_lTotalBytes = m_lTotalBytes + lenb(fldvalue)
       '检查文件总尺寸
       If m_lTotalMaxFileSize > 0 And m_lTotalMaxFileSize < m_lTotalBytes Then
         err.raise 27,"TooLargeFiles", "文件总尺寸过大"
       End If
       '检查文件类型
       ext = right(filepath, len(filepath)-instrrev(filepath, "."))
       If m_strAllowedFilesList <> "" Then
         afl = Split(m_strAllowedFilesList,"|")
         isTypeError = True
         For i = 0 To Ubound(afl)
           '找到了，允许
           If ucase(trim(ext)) = ucase(trim(afl(i))) Then
             isTypeError = False
             Exit For
           End If
         Next
         If isTypeError Then _
           err.raise 28,"InvalidFileType", "文件"&fldname&"类型错误"
       End If
       If m_strDeniedFilesList <> "" Then
         dfl = Split(m_strDeniedFilesList,"|")
         For i = 0 To Ubound(dfl)
           '找到了，不允许
           If ucase(trim(ext)) = ucase(trim(dfl(i))) Then _
             err.raise 28,"InvalidFileType", "文件"&fldname&"类型错误"
         Next
       End If

       fElement.Add fldname, fldvalue, contenttype, filepath
       m_dicFiles.Add fldname, fElement
     End If
   End If

   ' 截取剩下的部分，递归调用这个函数，来得到下一个part1。
   Call fillEveryFirstPart(rightb(data, lenb(data)-endpos-1))
 End Sub

 ' 这是一个公用函数，作用是二进制和字符串的转换
 Private Function B2S(bstr)
   Dim bchr, temp, i
   If not IsNull(bstr) Then
     for i = 0 to lenb(bstr) - 1
       bchr = midb(bstr,i+1,1)
       If ascb(bchr) > 127 Then '遇到了双字节，就得两个字符一起处理
         temp = temp & chr(ascw(midb(bstr, i+2, 1) & bchr))
         i = i+1
       Else
         temp = temp & chr(ascb(bchr))
       End If
     next
   End If
   B2S = temp
 End Function

End Class

' 这是一个辅助类，为了实现ourRequest.Forms.Count功能。
Class Counter
 Private m_iCnt

   ' count是咱们这个类的一个只读属性
 Public Property Get Count()
   Count = m_iCnt
 End Property

 Public Function setCount(cnt)
   m_iCnt = cnt
 End Function
End Class
%>