First, I'll list all the code that is needed for the component, and then we can examine it more closely. Add the following code to cUpload.
Option Explicit
'*****************************************************************
' Purpose: Retrieve a file by HTTP protocol
and writes this file
'
to a location on the webserver
'*****************************************************************
'Error Definitions
Private Const ERR_FIELD_DOES_NOT_EXIST As Long = vbObjectError + 102
Private MyScriptingContext As ASPTypeLibrary.ScriptingContext
Private MyRequest
As ASPTypeLibrary.Request
Private cFormItems As
Collection
'*****************************************************************
' OnStartPage()
' Purpose: Capture of Active Server Pages objects
'*****************************************************************
Public Sub OnStartPage(PassedScriptingContext As ScriptingContext)
Set MyScriptingContext = PassedScriptingContext
Set MyRequest = MyScriptingContext.Request
'then build the form...
Set cFormItems = BuildForm()
End Sub
'*****************************************************************
' Item()
' Purpose: Return a form item
' Inputs: vKey -- the key or index of the item to return
' Returns: A cFormItem object
'*****************************************************************
Public Property Get Form(Key As Variant) As cFormItem
If FieldExists(Key) = False Then
Err.Raise ERR_FIELD_DOES_NOT_EXIST,
"UploadIt", "The specified item does not exist"
Else
Set Form = cFormItems(Key)
End If
End Property
'*****************************************************************
' Count()
' Purpose: Gets the number of form fields
' Returns: The number of form fields
'*****************************************************************
Public Property Get Count() As Long
Count = cFormItems.Count
End Property
'*****************************************************************
' BuildForm()
' Purpose: Parse the posted form.
' Returns: A collection containing all the forms fields.
'*****************************************************************
Private Function BuildForm() As Collection
On Error GoTo BuildForm_Err
'Variables
Dim varByteCount As Variant 'the number of bytes
sent
Dim varHTTPHeader As Variant 'the HTTP header
Dim varDelimeter As Variant 'the delimiter that divides
the fields
Dim varFields As Collection 'contains all the form
fields
Dim lngFormFieldNameStart As Long 'start pos of the form
field
Dim lngFormFieldNameEnd As Long 'end pos of
the form field
Dim strFormFieldName As String 'name
of the form field
Dim lngFormFieldValueStart As Long
Dim lngFormFieldValueEnd As Long
Dim strFormFieldValue As String
Dim strFileName As String
'the filename
Dim strContentType As String
Dim lngFileDataStart As Long
Dim lngFileDataEnd As Long
Dim lngFileLength As Long
Dim clsFormField As cFormItem 'a form item...
'Initialize collection
Set varFields = New Collection
'Count total bytes in HTTP-header
varByteCount = MyRequest.TotalBytes
If varByteCount = 0 Then GoTo BuildForm_ExitProc
'Conversion of bytes to unicode
varHTTPHeader = StrConv(MyRequest.BinaryRead(varByteCount),
vbUnicode)
'Delimeter string
varDelimeter = LeftB(varHTTPHeader, 76)
'Determine where the first FormFieldName starts
lngFormFieldNameStart = InStrB(lngFormFieldNameStart +
1, varHTTPHeader, "; name=" & Chr(34))
Do While lngFormFieldNameStart <> 0
'Initialize Form Field object
Set clsFormField = New cFormItem
'Determine where FormFieldName
ends
lngFormFieldNameEnd = InStrB(lngFormFieldNameStart
+ Len(StrConv("; name=" & Chr(34), vbUnicode)), varHTTPHeader,
Chr(34)) + Len(StrConv(Chr(34), vbUnicode))
'Get the FormFieldName
strFormFieldName = MidB(varHTTPHeader,
lngFormFieldNameStart + Len(StrConv("; name=" & Chr(34), vbUnicode)),
(lngFormFieldNameEnd - Len(StrConv(Chr(34), vbUnicode))) - (lngFormFieldNameStart
+ Len(StrConv("; name=" & Chr(34), vbUnicode))))
'Check for file
If MidB(varHTTPHeader, lngFormFieldNameEnd,
2) = ";" Then
'find the
start/end positions of filename
lngFormFieldValueStart
= InStrB(lngFormFieldNameEnd, varHTTPHeader, "filename=" & Chr(34))
+ Len(StrConv("filename=" & Chr(34), vbUnicode))
lngFormFieldValueEnd
= InStrB(lngFormFieldValueStart, varHTTPHeader, Chr(34))
'Parse
filename from HTTPHeader
strFileName
= MidB(varHTTPHeader, lngFormFieldValueStart, lngFormFieldValueEnd - lngFormFieldValueStart)
'Remove
path from filename
strFileName
= GetFileName(strFileName)
'Check
to see if there is a filename
If Len(strFileName)
= 0 Then GoTo NextItem
'find the
start/end positions of content-type
lngFormFieldValueStart
= InStrB(lngFormFieldNameEnd, varHTTPHeader, vbCrLf & "Content-Type:
") + Len(StrConv(vbCrLf & "Content-Type: ", vbUnicode))
lngFormFieldValueEnd
= InStrB(lngFormFieldValueStart, varHTTPHeader, vbCrLf)
'Parse
filename from HTTPHeader
strContentType
= MidB(varHTTPHeader, lngFormFieldValueStart, lngFormFieldValueEnd - lngFormFieldValueStart)
'Determine
where filedata begins
lngFileDataStart
= InStrB(lngFormFieldValueEnd, varHTTPHeader, vbCrLf & vbCrLf) + Len(StrConv(vbCrLf
& vbCrLf, vbUnicode))
'Determine
where filedata ends
lngFileDataEnd
= InStrB(lngFileDataStart, varHTTPHeader, vbCrLf & varDelimeter)
'get the
length of the file
lngFileLength
= lngFileDataEnd - lngFileDataStart
'add form
field data
clsFormField.Add
"FileName", strFileName
clsFormField.Add
"FileLen", lngFileLength
clsFormField.Add
"ContentType", strContentType
'save the
files data to the collection...
clsFormField.FileData
= MidB(varHTTPHeader, lngFileDataStart, lngFileLength)
'we will
search for next field from here...
lngFormFieldNameStart
= lngFileDataEnd
Else
'Determine
where filedata begins
lngFormFieldValueStart
= InStrB(lngFormFieldNameEnd, varHTTPHeader, vbCrLf & vbCrLf) + Len(StrConv(vbCrLf
& vbCrLf, vbUnicode))
'Determine
where filedata ends
lngFormFieldValueEnd
= InStrB(lngFormFieldValueStart, varHTTPHeader, vbCrLf & varDelimeter)
'Filter
formfieldvalue
strFormFieldValue
= MidB(varHTTPHeader, lngFormFieldValueStart, lngFormFieldValueEnd - lngFormFieldValueStart)
'we will
search for next field from here...
lngFormFieldNameStart
= lngFormFieldValueEnd
'save the
fields value
clsFormField.Add
"Value", strFormFieldValue
End If
clsFormField.Add "Name",
strFormFieldName
'Assign formfieldnames and formfieldvalues
to collection
varFields.Add clsFormField, strFormFieldName
NextItem:
'destroy form field object
Set clsFormField = Nothing
'find the next form field object
lngFormFieldNameStart = InStrB(lngFormFieldNameStart
+ 1, varHTTPHeader, "; name=" & Chr(34))
Loop
BuildForm_ExitProc:
'Return an array with the formfield names and values
Set BuildForm = varFields
Exit Function
BuildForm_Err:
Err.Raise Err, "ASPUploadComponent", "Unhandled
error: " & Error
End Function
'*****************************************************************
' ItemExists()
' Purpose: Determines if a field exists.
' Inputs: strKey --
A string containing the key to search for
' Returns: Whether the entry exists or not
'*****************************************************************
Public Function FieldExists(ByVal Key As Variant) As Boolean
Dim cItem As cFormItem
On Error Resume Next
Set cItem = cFormItems(Key)
If Err = 0 Then FieldExists = True
End Function
'*****************************************************************
' GetFileName()
' Purpose: Parses the filename from the filepath.
' Inputs: strFilePath -- String containing
filepath and filename
' Returns: A string which contains the filename
'*****************************************************************
Private Function GetFileName(strFilePath) As String
Dim intPos As Integer
GetFileName = strFilePath
For intPos = Len(strFilePath) To 1 Step -1
If Mid(strFilePath, intPos, 1)
= "\" Or Mid(strFilePath, intPos, 1) = ":" Then
GetFileName
= Right(strFilePath, Len(strFilePath) - intPos)
Exit Function
End If
Next
End Function
Comments