Uploading a file in classic asp

Question

I've always used the following script to upload files in classic asp, but it stopped working giving me this error

vbscript runtime error 800a01a8
object required 'Item(...)'

I investigated a little and i think that the problem is in the file upload.asp with the function BuildUploadRequest, but i really can't understand why

form

<form method="POST" action="landing-page.asp" ENCTYPE="multipart/form-data">
    <input type="file" name="file">
    <input type="hidden" name="key" value="0">
    <input type="submit" name="send" value="1">
</form>

page where the form lands

byteCount = Request.TotalBytes
RequestBin = Request.BinaryRead(byteCount)

Dim UploadRequest
Set UploadRequest = CreateObject("Scripting.Dictionary")
BuildUploadRequest(RequestBin)  '//function defined in upload.asp
if UploadRequest.Item("key").Item("Value")="0" then  '//this is the line giving the error
    '//code here...
end if

upload.asp

Sub BuildUploadRequest(RequestBin)
    PosBeg = 1  
    PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
    boundary = MidB(RequestBin,PosBeg,PosEnd-PosBeg)    
    boundaryPos = InstrB(1,RequestBin,boundary)

    '//Get all data inside the boundaries
    Do until (boundaryPos=InstrB(RequestBin,boundary & getByteString("--")))
        '//Members variable of objects are put in a dictionary object
        Dim UploadControl
        Set UploadControl = CreateObject("Scripting.Dictionary")
        '//Get an object name
        Pos = InstrB(BoundaryPos,RequestBin,getByteString("Content-Disposition"))
        Pos = InstrB(Pos,RequestBin,getByteString("name="))
        PosBeg = Pos+6
        PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(34)))
        Name = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
        PosFile = InstrB(BoundaryPos,RequestBin,getByteString("filename="))
        PosBound = InstrB(PosEnd,RequestBin,boundary)
        '//Test if object is of file type
        If  PosFile<>0 AND (PosFile<PosBound) Then
            '//Get Filename, content-type and content of file
            PosBeg = PosFile + 10
            PosEnd =  InstrB(PosBeg,RequestBin,getByteString(chr(34)))
            FileName = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
            '//Add filename to dictionary object
            UploadControl.Add "FileName", FileName
            Pos = InstrB(PosEnd,RequestBin,getByteString("Content-Type:"))
            PosBeg = Pos+14
            PosEnd = InstrB(PosBeg,RequestBin,getByteString(chr(13)))
            '//Add content-type to dictionary object
            ContentType = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
            UploadControl.Add "ContentType",ContentType
            '//Get content of object
            PosBeg = PosEnd+4
            PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
            Value = MidB(RequestBin,PosBeg,PosEnd-PosBeg)
        Else
            '//Get content of object
            Pos = InstrB(Pos,RequestBin,getByteString(chr(13)))
            PosBeg = Pos+4
            PosEnd = InstrB(PosBeg,RequestBin,boundary)-2
            Value = getString(MidB(RequestBin,PosBeg,PosEnd-PosBeg))
        End If
        '//Add content to dictionary object
        UploadControl.Add "Value" , Value   
        '//Add dictionary object to main dictionary
        '//response.write name & "<br>"
        UploadRequest.Add name, UploadControl   
        '//Loop to next object
        BoundaryPos=InstrB(BoundaryPos+LenB(boundary),RequestBin,boundary)
    Loop
End Sub

'//String to byte string conversion
Function getByteString(StringStr)
  For i = 1 to Len(StringStr)
    charx = Mid(StringStr,i,1)
    getByteString = getByteString & chrB(AscB(charx))
  Next
End Function

'//Byte string to string conversion
Function getString(StringBin)
 getString =""
 For intCount = 1 to LenB(StringBin)
    getString = getString & chr(AscB(MidB(StringBin,intCount,1))) 
 Next
End Function

This code has always worked properly in every project, but now it's not working everywhere. So i can't just edit and use another function, i need to understand why it doesn't work anymore

Solution 1

Fix #1 - Uninstall "KB3104002 Cumulative security update for IE11"

Fix #2 - Copy all byte arrays into a string of byte values and work against that, or provide a substitute for instrb that does its own iteration over the array.

Function InstrBNew(startPos, inputArray, searchChar)

  if LenB(searchChar) = 1 Then
    Dim loc
    For loc = startPos to Lenb(inputArray)
      if MidB(inputArray, loc, 1) = searchChar then Exit For
    Next
    InstrBNew = loc
  Else
    InstrBNew = InstrB(startPos, inputArray, searchChar)
  End If
End Function

Fix #3 - Microsoft has released a hotfix. This will go out to everyone in January 2016. You can get it early here. https://support.microsoft.com/en-us/kb/3125446

The problem seems to be that the InstrB function in vbScript now returns a value of 1 under the following conditions.

• When you are searching a byte array (Such as Response.BinaryRead). This isn't very common in ASP or VBScript, but file uploads is one of those times when you're doing it.
• When you are searching for a single byte

If you are searching a string, or if you are searching for a multibyte pattern, then InstrB works properly.

PosEnd = InstrB(PosBeg, ByteArray, chrb(13))

On my broken systems, this function always returns a 1, even though there is no byte value 13 at position 1. It returns 1 for any value when searching a byte array. The classic ASP file upload components, which is why we're all on this thread, run into this situation because they're parsing that byte array looking for delimiters.

PosEnd = InstrB(PosBeg,ByteArray,getByteString("FormBoundary"))
PosEnd = InstrB(PosBeg,ByteArray,getByteString(vbCRLF))
PosEnd = InstrB(PosBeg,"Normal string", chrb(103)) ' Search for letter g in a string

These above lines work fine and as expected. Multibyte searches and matches against a string work expectedly.

This problem hit me simultaneously across multiple servers last night. I saw that windows system updates ran last night also. Narrowing it down, I found that MS15-124 (KB3104002 Cumulative security update for IE11) contained an update for vbscript.dll. I removed this update and now the code returns to working properly.

I filed an issue on their "IE Connect" system, since it was included in an IE update, but I'm not sure if that's the right place.

I've attached a test case. On broken systems, it will return "5, 1, 5". On working systems it will return "5, 5, 5"

Hoping for a fix. Some of this old code is running on systems I don't have access to.

' Test.vbs
Dim byteArray, byteArray2, byteArray3, bPosition
Dim responseText

' byte string
' "hello hello"
byteArray = chrb(104) & chrb(101) & chrb(108) & chrb(108) & chrb(111) & chrb(32) & chrb(104) & chrb(101) & chrb(108) & chrb(108) & chrb(111) & chrb(0)

' byte array - What Response.BinaryRead is
byteArray2 = TextToBytes(byteArray)

' Vartype: http://stackoverflow.com/questions/3281355/get-the-type-of-a-variable-in-vbscript
ResponseText = ResponseText + "blen: " & lenb(byteArray) & vbCRLF
ResponseText = ResponseText + "type: " & vartype(byteArray) & vbCRLF

ResponseText = ResponseText + "blen: " & lenb(byteArray2) & vbCRLF
ResponseText = ResponseText + "type: " & vartype(byteArray2) & vbCRLF

bPosition = instrb(1, byteArray, chrb(111))
ResponseText = ResponseText + "Position in string: " & bPosition & vbCRLF

bPosition = instrb(1, byteArray2, chrb(111))
ResponseText = ResponseText + "Position in byte array: " & bPosition & vbCRLF

bPosition = instrb(1, byteArray2, chrb(111) & chrb(32))
ResponseText = ResponseText + "Position in byte array: " & bPosition & vbCRLF

WScript.Echo ResponseText

' Converts a string (8) to a vbArray of bytes (8192 + 17)
' I'm not sure how else to create a vbArray of bytes. It does not seem to be a common data type in vbscript
Private Function TextToBytes(ByRef pbinBinaryData)
    Dim lobjRs
    Dim llngLength
    Dim lbinBuffer
    CONST adLongVarBinary = 205
    llngLength = LenB(pbinBinaryData)
    Set lobjRs = CreateObject("ADODB.Recordset")
    Call lobjRs.Fields.Append("BinaryData", adLongVarBinary, llngLength)
    Call lobjRs.Open()
    Call lobjRs.AddNew()
    Call lobjRs.Fields("BinaryData").AppendChunk(pbinBinaryData)
    Call lobjRs.Update()
    lbinBuffer = lobjRs.Fields("BinaryData").GetChunk(llngLength)
    Call lobjRs.Close()
    Set lobjRs = Nothing
    TextToBytes = lbinBuffer
End Function

Solution 2

I had the same problem in classic ASP, InStrB suddenly returning 1 even when I validated in debugger that it should not i.e. character in question was at position 17.

I wrote the following replacement function for InStrB (only for use when looking for 1 char). I'm a crappy VBS programmer, so, feel free to clean this up. But it does seem to work...

Private Function findCharInStrB(startPos, inputArray, searchChar)
  Dim loc
  For loc = startPos to Len(inputArray)
    if MidB(inputArray, loc, 1) = searchChar then Exit For
  Next
  findCharInStrB = loc
End Function

Solution 3

Microsoft has released a Hotfix to fix this issue.

https://support.microsoft.com/en-us/kb/3125446

Comments

[Zeev G]

THANK YOU!!!!!!!!!! removed the update and it worked!here is how to remove update windows.microsoft.com/en-us/windows/remove-update#1TC=window‌​s-7

[Dijkgraaf]

I would recommend Fix #3 and to apply the hotfix rather than removing the update.

[Kev]

Top notch answer Matt.