home *** CD-ROM | disk | FTP | other *** search
/ 202.53.64.216 / 202.53.64.216.tar / 202.53.64.216 / janahitha / Admin / clsUpload.asp < prev    next >
Text File  |  2004-11-26  |  9KB  |  238 lines
  1. <SCRIPT LANGUAGE=vbscript RUNAT=Server>
  2. Class clsUpload
  3. '========================================================='
  4. '    This class will parse the binary contents of the       '
  5. '    request, and populate the Form and Files collections. '
  6. '========================================================='
  7.     Private m_objFiles
  8.     Private m_objForm
  9.     
  10.     Public Property Get Form()
  11.         Set Form = m_objForm
  12.     End Property
  13.     
  14.     Public Property Get Files()
  15.         Set Files = m_objFiles
  16.     End Property
  17.     
  18.     Private Sub Class_Initialize()
  19.         Set m_objFiles = New clsCollection
  20.         Set m_objForm = New clsCollection
  21.         ParseRequest
  22.     End Sub
  23.     
  24.     Private Sub ParseRequest()
  25.         Dim lngTotalBytes, lngPosBeg, lngPosEnd, lngPosBoundary, lngPosTmp, lngPosFileName
  26.         Dim strBRequest, strBBoundary, strBContent
  27.         Dim strName, strFileName, strContentType, strValue, strTemp
  28.         Dim objFile
  29.                 
  30.         'Grab the entire contents of the Request as a Byte string
  31.         lngTotalBytes = Request.TotalBytes
  32.         strBRequest = Request.BinaryRead(lngTotalBytes)
  33.         
  34.         'Find the first Boundary
  35.         lngPosBeg = 1
  36.         lngPosEnd = InStrB(lngPosBeg, strBRequest, UStr2Bstr(Chr(13)))
  37.         If lngPosEnd > 0 Then
  38.             strBBoundary = MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg)
  39.             lngPosBoundary = InStrB(1, strBRequest, strBBoundary)
  40.         End If
  41.         If strBBoundary = "" Then
  42.         'The form must have been submitted *without* ENCTYPE="multipart/form-data"
  43.         'But since we already called Request.BinaryRead, we can no longer access
  44.         'the Request.Form collection, so we need to parse the request and populate
  45.         'our own form collection.
  46.             lngPosBeg = 1
  47.             lngPosEnd = InStrB(lngPosBeg, strBRequest, UStr2BStr("&"))
  48.             Do While lngPosBeg < LenB(strBRequest)
  49.                 'Parse the element and add it to the collection
  50.                 strTemp = BStr2UStr(MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg))
  51.                 lngPosTmp = InStr(1, strTemp, "=")
  52.                 strName = URLDecode(Left(strTemp, lngPosTmp - 1))
  53.                 strValue = URLDecode(Right(strTemp, Len(strTemp) - lngPosTmp))
  54.                 m_objForm.Add strName, strValue
  55.                 'Find the next element
  56.                 lngPosBeg = lngPosEnd + 1
  57.                 lngPosEnd = InStrB(lngPosBeg, strBRequest, UStr2BStr("&"))
  58.                 If lngPosEnd = 0 Then lngPosEnd = LenB(strBRequest) + 1
  59.             Loop
  60.         Else
  61.         'The form was submitted with ENCTYPE="multipart/form-data"
  62.         'Loop through all the boundaries, and parse them into either the
  63.         'Form or Files collections.
  64.             Do Until (lngPosBoundary = InStrB(strBRequest, strBBoundary & UStr2Bstr("--")))
  65.                 'Get the element name
  66.                 lngPosTmp = InStrB(lngPosBoundary, strBRequest, UStr2BStr("Content-Disposition"))
  67.                 lngPosTmp = InStrB(lngPosTmp, strBRequest, UStr2BStr("name="))
  68.                 lngPosBeg = lngPosTmp + 6
  69.                 lngPosEnd = InStrB(lngPosBeg, strBRequest, UStr2BStr(Chr(34)))
  70.                 strName = BStr2UStr(MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg))
  71.                 'Look for an element named 'filename'
  72.                 lngPosFileName = InStrB(lngPosBoundary, strBRequest, UStr2BStr("filename="))
  73.                 'If found, we have a file, otherwise it is a normal form element
  74.                 If lngPosFileName <> 0 And lngPosFileName < InStrB(lngPosEnd, strBRequest, strBBoundary) Then 'It is a file
  75.                     'Get the FileName
  76.                     lngPosBeg = lngPosFileName + 10
  77.                     lngPosEnd = InStrB(lngPosBeg, strBRequest, UStr2BStr(chr(34)))
  78.                     strFileName = BStr2UStr(MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg))
  79.                     'Get the ContentType
  80.                     lngPosTmp = InStrB(lngPosEnd, strBRequest, UStr2BStr("Content-Type:"))
  81.                     lngPosBeg = lngPosTmp + 14
  82.                     lngPosEnd = InstrB(lngPosBeg, strBRequest, UStr2BStr(chr(13)))
  83.                     strContentType = BStr2UStr(MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg))
  84.                     'Get the Content
  85.                     lngPosBeg = lngPosEnd + 4
  86.                     lngPosEnd = InStrB(lngPosBeg, strBRequest, strBBoundary) - 2
  87.                     strBContent = MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg)
  88.                     If strFileName <> "" And strBContent <> "" Then
  89.                         'Create the File object, and add it to the Files collection
  90.                         Set objFile = New clsFile
  91.                         objFile.Name = strName
  92.                         objFile.FileName = Right(strFileName, Len(strFileName) - InStrRev(strFileName, "\"))
  93.                         objFile.ContentType = strContentType
  94.                         objFile.Blob = strBContent
  95.                         m_objFiles.Add strName, objFile
  96.                     End If
  97.                 Else 'It is a form element
  98.                     'Get the value of the form element
  99.                     lngPosTmp = InStrB(lngPosTmp, strBRequest, UStr2BStr(chr(13)))
  100.                     lngPosBeg = lngPosTmp + 4
  101.                     lngPosEnd = InStrB(lngPosBeg, strBRequest, strBBoundary) - 2
  102.                     strValue = BStr2UStr(MidB(strBRequest, lngPosBeg, lngPosEnd - lngPosBeg))
  103.                     'Add the element to the collection
  104.                     m_objForm.Add strName, strValue
  105.                 End If
  106.                 'Move to Next Element
  107.                 lngPosBoundary = InStrB(lngPosBoundary + LenB(strBBoundary), strBRequest, strBBoundary)
  108.             Loop
  109.         End If
  110.     End Sub
  111.     
  112.     Private Function BStr2UStr(BStr)
  113.     'Byte string to Unicode string conversion
  114.         Dim lngLoop
  115.         BStr2UStr = ""
  116.         For lngLoop = 1 to LenB(BStr)
  117.             BStr2UStr = BStr2UStr & Chr(AscB(MidB(BStr,lngLoop,1))) 
  118.         Next
  119.     End Function
  120.     
  121.     Private Function UStr2Bstr(UStr)
  122.     'Unicode string to Byte string conversion
  123.         Dim lngLoop
  124.         Dim strChar
  125.         UStr2Bstr = ""
  126.         For lngLoop = 1 to Len(UStr)
  127.             strChar = Mid(UStr, lngLoop, 1)
  128.             UStr2Bstr = UStr2Bstr & ChrB(AscB(strChar))
  129.         Next
  130.     End Function
  131.     
  132.     Private Function URLDecode(Expression)
  133.     'Why doesn't ASP provide this functionality for us?
  134.         Dim strSource, strTemp, strResult
  135.         Dim lngPos
  136.         strSource = Replace(Expression, "+", " ")
  137.         For lngPos = 1 To Len(strSource)
  138.             strTemp = Mid(strSource, lngPos, 1)
  139.             If strTemp = "%" Then
  140.                 If lngPos + 2 < Len(strSource) Then
  141.                     strResult = strResult & Chr(CInt("&H" & Mid(strSource, lngPos + 1, 2)))
  142.                     lngPos = lngPos + 2
  143.                 End If
  144.             Else
  145.                 strResult = strResult & strTemp
  146.             End If
  147.         Next
  148.         URLDecode = strResult
  149.     End Function    
  150.     
  151. End Class
  152.  
  153. Class clsCollection
  154. '========================================================='
  155. '    This class is a pseudo-collection. It is not a real   '
  156. '    collection, because there is no way that I am aware   '
  157. '   of to implement an enumerator to support the          '
  158. '    For..Each syntax using VBScript classes.              '
  159. '========================================================='
  160.     Private m_objDicItems
  161.     
  162.     Private Sub Class_Initialize()
  163.         Set m_objDicItems = Server.CreateObject("Scripting.Dictionary")
  164.         m_objDicItems.CompareMode = vbTextCompare
  165.     End Sub
  166.     
  167.     Public Property Get Count()
  168.         Count = m_objDicItems.Count
  169.     End Property
  170.     
  171.     Public Default Function Item(Index)
  172.         Dim arrItems
  173.         If IsNumeric(Index) Then
  174.             arrItems = m_objDicItems.Items
  175.             If IsObject(arrItems(Index)) Then
  176.                 Set Item = arrItems(Index)
  177.             Else
  178.                 Item = arrItems(Index)
  179.             End If
  180.         Else
  181.             If m_objDicItems.Exists(Index) Then
  182.                 If IsObject(m_objDicItems.Item(Index)) Then
  183.                     Set Item = m_objDicItems.Item(Index)
  184.                 Else
  185.                     Item = m_objDicItems.Item(Index)
  186.                 End If
  187.             End If
  188.         End If
  189.     End Function
  190.     
  191.     Public Function Key(Index)
  192.         Dim arrKeys
  193.         If IsNumeric(Index) Then
  194.             arrKeys = m_objDicItems.Keys
  195.             Key = arrKeys(Index)
  196.         End If
  197.     End Function
  198.     
  199.     Public Sub Add(Name, Value)
  200.         If m_objDicItems.Exists(Name) Then
  201.             m_objDicItems.Item(Name) = Value
  202.         Else
  203.             m_objDicItems.Add Name, Value
  204.         End If
  205.     End Sub
  206. End Class
  207.  
  208. Class clsFile
  209. '========================================================='
  210. '    This class is used as a container for a file sent via '
  211. '    an http multipart/form-data post.                      '
  212. '========================================================='
  213.     Private m_strName
  214.     Private m_strContentType
  215.     Private m_strFileName
  216.     Private m_Blob
  217.     
  218.     Public Property Get Name() : Name = m_strName : End Property
  219.     Public Property Let Name(vIn) : m_strName = vIn : End Property
  220.     Public Property Get ContentType() : ContentType = m_strContentType : End Property
  221.     Public Property Let ContentType(vIn) : m_strContentType = vIn : End Property
  222.     Public Property Get FileName() : FileName = m_strFileName : End Property
  223.     Public Property Let FileName(vIn) : m_strFileName = vIn : End Property
  224.     Public Property Get Blob() : Blob = m_Blob : End Property
  225.     Public Property Let Blob(vIn) : m_Blob = vIn : End Property
  226.  
  227.     Public Sub Save(Path)
  228.         Dim objFSO, objFSOFile
  229.         Dim lngLoop
  230.         Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
  231.         Set objFSOFile = objFSO.CreateTextFile(objFSO.BuildPath(Path, m_strFileName))
  232.         For lngLoop = 1 to LenB(m_Blob)
  233.             objFSOFile.Write Chr(AscB(MidB(m_Blob, lngLoop, 1)))
  234.         Next
  235.         objFSOFile.Close    
  236.     End Sub
  237. End Class
  238. </SCRIPT>