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