Expand|Select|Wrap|Line Numbers
- <%
- ' ------------------------------------------------------------------------------
- ' Container of Field Properties
- Class clsField
- Public FileName
- Public ContentType
- Public Value
- Public FieldName
- Public Length
- Public BinaryData
- End Class
- ' ------------------------------------------------------------------------------
- Class clsUpload
- ' ------------------------------------------------------------------------------
- Private nFieldCount
- Private oFields()
- Private psFileFullPath
- Private psError
- Private psFileInputName
- ' ------------------------------------------------------------------------------
- Public Property Get Count()
- Count = nFieldCount
- End Property
- ' ------------------------------------------------------------------------------
- Public Default Property Get Field(ByRef asFieldName)
- Dim lnLength
- Dim lnIndex
- lnLength = UBound(oFields)
- If IsNumeric(asFieldName) Then
- If lnLength >= asFieldName And asFieldName > -1 Then
- Set Field = oFields(asFieldName)
- Else
- Set Field = New clsField
- End If
- Else
- For lnIndex = 0 To lnLength
- If LCase(oFields(lnIndex).FieldName) = LCase(asFieldName) Then
- Set Field = oFields(lnIndex)
- Exit Property
- End If
- Next
- Set Field = New clsField
- End If
- End Property
- ' ------------------------------------------------------------------------------
- Public Function Exists(ByRef avKeyIndex)
- Exists = Not IndexOf(avKeyIndex) = -1
- End Function
- ' ------------------------------------------------------------------------------
- Public Property Get ValueOf(ByRef avKeyIndex)
- Dim lnIndex
- lnIndex = IndexOf(avKeyIndex)
- if lnIndex = -1 Then Exit Property
- ValueOf = oFields(lnIndex).Value
- End Property
- ' ------------------------------------------------------------------------------
- Public Property Get FileNameOf(ByRef avKeyIndex)
- Dim lnIndex
- lnIndex = IndexOf(avKeyIndex)
- if lnIndex = -1 Then Exit Property
- FileNameOf = oFields(lnIndex).FileName
- End Property
- ' ------------------------------------------------------------------------------
- Public Property Get LengthOf(ByRef avKeyIndex)
- Dim lnIndex
- lnIndex = IndexOf(avKeyIndex)
- if lnIndex = -1 Then Exit Property
- LengthOf = oFields(lnIndex).Length
- End Property
- ' ------------------------------------------------------------------------------
- Public Property Get BinaryDataOf(ByRef avKeyIndex)
- Dim lnIndex
- lnIndex = IndexOf(avKeyIndex)
- if lnIndex = -1 Then Exit Property
- BinaryDataOf = oFields(lnIndex).BinaryData
- End Property
- ' ------------------------------------------------------------------------------
- Private Function IndexOf(ByVal avKeyIndex)
- Dim lnIndex
- If avKeyIndex = "" Then
- IndexOf = -1
- ElseIf IsNumeric(avKeyIndex) Then
- avKeyIndex = CLng(avKeyIndex)
- If nFieldCount > avKeyIndex And avKeyIndex > -1 Then
- IndexOf = avKeyIndex
- Else
- IndexOf = -1
- End If
- Else
- For lnIndex = 0 To nFieldCount - 1
- If LCase(oFields(lnIndex).FieldName) = LCase(avKeyIndex) Then
- IndexOf = lnIndex
- Exit Function
- End If
- Next
- IndexOf = -1
- End If
- End Function
- ' ------------------------------------------------------------------------------
- Public Property Let FileFullPath(sValue)
- psFileFullPath = sValue
- End Property
- '___________________________________________________________________________________
- Public Property Get FileFullPath()
- FileFullPath = psFileFullPath
- End Property
- ' ------------------------------------------------------------------------------
- Public Property Let FileInputName(sValue)
- psFileInputName = sValue
- End Property
- ' -------------------- ----------------------------------------------------------
- Public Function Save()
- if psFileFullPath <> "" and psFileInputName <> "" then
- 'Save to connectionless client side recordset, write to stream,
- 'and persist stream.
- 'would think you should be able to write directly to
- 'stream without recordset, but I could not get that to work
- On error resume next
- binData = o.BinaryDataOf(psFileInputName)
- set rs = server.createobject("ADODB.RECORDSET")
- rs.fields.append "FileName", 205, LenB(binData)
- rs.open
- rs.addnew
- rs.fields(0).AppendChunk binData
- if err.number = 0 then
- set objStream = Server.CreateObject("ADODB.Stream")
- objStream.Type = 1
- objStream.Open
- objStream.Write rs.fields("FileName").value
- objStream.SaveToFile psFileFullPath, 2
- objStream.close
- set objStream = Nothing
- ENd if
- rs.close
- set rs = nothing
- psError = Err.Description
- else
- psError = "One or more required properties (FileFullPath and/or FileInputName) not set"
- End If
- End Function
- Public Property Get Error()
- Error = psError
- End Property
- ' ------------------------------------------------------------------------------
- Public Property Get ContentTypeOf(ByRef avKeyIndex)
- Dim lnIndex
- lnIndex = IndexOf(avKeyIndex)
- if lnIndex = -1 Then Exit Property
- ContentTypeOf = oFields(lnIndex).ContentType
- End Property
- ' ------------------------------------------------------------------------------
- Private Sub Class_Terminate()
- Dim lnIndex
- For lnIndex = 0 To nFieldCount - 1
- Set oFields(0) = Nothing
- Next
- End Sub
- ' ------------------------------------------------------------------------------
- Private Sub Class_Initialize()
- Dim lnBytes ' Bytes received from the client
- Dim lnByteCount ' Number of bytes received
- Dim lnStartPosition ' Position at which content begins
- Dim lnEndPosition ' Position at which content ends
- Dim loDic ' Contains properties of each
- ' specific field
- ' Local dictionary object(s)
- ' to be appended to class-scope
- ' dictioary object.
- Dim lnBoundaryBytes ' Bytes contained within the current boundary
- Dim lnBoundaryStart ' Position at wich the current boundary begins
- ' within the lnBytes binary data.
- Dim lnBoundaryEnd ' Position at wich the current boundary ends
- ' within the lnBytes binary data.
- Dim lnDispositionPosition
- Dim lsFieldName ' Name of the current field being parsed from
- ' Binary Data
- Dim lsFileName ' Name of the file within the current boundary
- Dim lnFileNamePosition ' Location of file name within current boundary
- Dim loField ' clsField Object
- Dim lsValue ' Value of the current field
- Dim lsContentType ' ContentType of the binary file (MIME Type)
- ' Initialize Fields
- nFieldCount = 0
- ReDim oFields(-1)
- ' Read the bytes (binary data) into memory
- lnByteCount = Request.TotalBytes
- lnBytes = Request.BinaryRead(lnByteCount)
- 'Get the lnBoundaryBytes
- lnStartPosition = 1
- lnEndPosition = InstrB(lnStartPosition, lnBytes, CStrB(vbCr))
- If lnEndPosition >= lnStartPosition Then
- lnBoundaryBytes = MidB(lnBytes, lnStartPosition, lnEndPosition - lnStartPosition)
- End If
- lnBoundaryStart = InstrB(1, lnBytes, lnBoundaryBytes)
- ' Loop until the BoundaryBytes begin with "--"
- Do Until (lnBoundaryStart = InstrB(lnBytes, lnBoundaryBytes & CStrB("--")))
- ' All data within this boundary is stored within a local dictionary
- ' to be appended to the class-scope dictionary.
- ReDim Preserve oFields(nFieldCount)
- nFieldCount = nFieldCount + 1
- Set loField = New clsField
- lnDispositionPosition = InstrB(lnBoundaryStart, lnBytes, CStrB("Content-Disposition"))
- ' Get an object name
- lnStartPosition = InstrB(lnDispositionPosition, lnBytes, CStrB("name=")) + 6
- lnEndPosition = InstrB(lnStartPosition, lnBytes, CStrB(""""))
- lsFieldName = CStrU(MidB(lnBytes, lnStartPosition, lnEndPosition - lnStartPosition))
- loField.FieldName = lsFieldName
- ' Get the location fo the file name.
- lnFileNamePosition = InstrB(lnBoundaryStart, lnBytes, CStrB("filename="))
- lnBoundaryEnd = InstrB(lnEndPosition, lnBytes, lnBoundaryBytes)
- 'Test if object is a file
- If Not lnFileNamePosition = 0 And lnFileNamePosition < lnBoundaryEnd Then
- ' Parse Filename
- lnStartPosition = lnFileNamePosition + 10
- lnEndPosition = InstrB(lnStartPosition, lnBytes, CStrB(""""))
- lsFileName = CStrU(MidB(lnBytes,lnStartPosition,lnEndPosition-lnStartPosition))
- loField.FileName = lsFileName
- ' Parse Content-Type
- lnStartPosition = InstrB(lnEndPosition,lnBytes,CStrB("Content-Type:")) + 14
- lnEndPosition = InstrB(lnStartPosition,lnBytes,CStrB(vbCr))
- lsContentType = CStrU(MidB(lnBytes,lnStartPosition,lnEndPosition-lnStartPosition))
- loField.ContentType = lsContentType
- ' Parse Content
- lnStartPosition = lnEndPosition + 4
- lnEndPosition = InstrB(lnStartPosition,lnBytes,lnBoundaryBytes)-2
- lsValue = MidB(lnBytes,lnStartPosition,lnEndPosition-lnStartPosition)
- loField.BinaryData = lsValue & CStrB(vbNull)
- loField.Length = LenB(lsValue)
- Else
- ' Parse Content
- lnStartPosition = InstrB(lnDispositionPosition, lnBytes, CStrB(vbCr)) + 4
- lnEndPosition = InstrB(lnStartPosition, lnBytes, lnBoundaryBytes) - 2
- lsValue = CStrU(MidB(lnBytes,lnStartPosition,lnEndPosition-lnStartPosition))
- loField.Value = lsValue
- loField.Length = Len(lsValue)
- End If
- Set oFields(UBound(oFields)) = loField
- 'Loop to next object
- lnBoundaryStart = InstrB(lnBoundaryStart + LenB(lnBoundaryBytes), lnBytes, lnBoundaryBytes)
- Set loField = Nothing
- Loop
- End Sub
- ' ------------------------------------------------------------------------------
- Private Function CStrU(ByRef psByteString)
- Dim lnLength
- Dim lnPosition
- lnLength = LenB(psByteString)
- For lnPosition = 1 To lnLength
- CStrU = CStrU & Chr(AscB(MidB(psByteString, lnPosition, 1)))
- Next
- End Function
- ' ------------------------------------------------------------------------------
- Private Function CStrB(ByRef psUnicodeString)
- Dim lnLength
- Dim lnPosition
- lnLength = Len(psUnicodeString)
- For lnPosition = 1 To lnLength
- CStrB = CStrB & ChrB(AscB(Mid(psUnicodeString, lnPosition, 1)))
- Next
- End Function
- ' ------------------------------------------------------------------------------
- End Class
- ' ------------------------------------------------------------------------------
- %>