Uploading a file in classic asp

问题:

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

回答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

回答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

回答3:

Microsoft has released a Hotfix to fix this issue.

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

回答4:

Try this upload code (credit to Lewis Moten) instead: http://planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=8525&lngWId=4

I ran into the same problem recently when migrating a site to a newer version of Windows Server. Using Lewis Moten's upload code instead fixed the problem.

In case the link dies, the code is also posted in this answer.

回答5:

I can't respond to the original comment due to low-rep, but in case you can't remove the update using the normal Control Panel methods like I couldn't (It didn't appear in the list of uninstalls) here is how you do it with Powershell and the command line:

Temporary workaround to Uninstall "KB3104002 Cumulative security update for IE11":

Do the following to check if an update is installed:

1. Tap on the Windows-key (or Right Click on Windows button, etc) and type `cmd` and hit enter.
2. Type `powershell` and hit enter.
3. Use the command `get-hotfix -id KB3104002` to find out whether the update is installed. You will see a list returned with the install date of this update if it is.

If the update is installed, continue:

1. If you are still in powershell type `exit` to leave.
2. Use the command `wusa /uninstall /kb:3104002` to uninstall the patch
3. Reboot!

Caveat: KB3104002 is listed as a "Critical Security Update" according to Microsoft so I wouldn't recommend ignoring this update forever, but as a temporary resolution to the issues this update causes, this is what I chose to do. I am thinking that Microsoft will be issuing an update to this update which deals with the carnage it is apparently causing with ASP code still in use.