vbscript runtime error 800a01a8
object required ‘Item(…)’
我调查了一点,我认为问题是在文件upload.asp与功能BuildUploadRequest,但我真的不明白为什么
形成
<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>
表格登陆的页面
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,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,getByteString("Content-Disposition")) Pos = InstrB(Pos,getByteString("name=")) PosBeg = Pos+6 PosEnd = InstrB(PosBeg,getByteString(chr(34))) Name = getString(MidB(RequestBin,PosEnd-PosBeg)) PosFile = InstrB(BoundaryPos,getByteString("filename=")) PosBound = InstrB(PosEnd,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,getByteString(chr(34))) FileName = getString(MidB(RequestBin,PosEnd-PosBeg)) '//Add filename to dictionary object UploadControl.Add "FileName",FileName Pos = InstrB(PosEnd,getByteString("Content-Type:")) PosBeg = Pos+14 PosEnd = InstrB(PosBeg,getByteString(chr(13))) '//Add content-type to dictionary object ContentType = getString(MidB(RequestBin,PosEnd-PosBeg)) UploadControl.Add "ContentType",ContentType '//Get content of object PosBeg = PosEnd+4 PosEnd = InstrB(PosBeg,boundary)-2 Value = MidB(RequestBin,PosEnd-PosBeg) Else '//Get content of object Pos = InstrB(Pos,getByteString(chr(13))) PosBeg = Pos+4 PosEnd = InstrB(PosBeg,boundary)-2 Value = getString(MidB(RequestBin,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),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
这个代码在每一个项目中一直运行正常,但是现在它无处不在。所以我不能只是编辑和使用另一个功能,我需要明白为什么它不再工作了
解决方法
修复#2 – 将所有字节数组复制到一个字节值字符串中,并针对该字符串进行处理,或提供对instrb进行自身迭代的替代。
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,searchChar) End If End Function
修复#3 – Microsoft已经发布了一个修补程序。这将在2016年1月份出现给大家。你可以在这里早点解决。 https://support.microsoft.com/en-us/kb/3125446
问题似乎是,在以下条件下,vbScript中的InstrB函数现在返回值为1。
>当您搜索字节数组(如Response.BinaryRead)时。这在ASP或VBScript中不是很常见,但文件上传是您正在做的时间之一。
>当您搜索单个字节时
如果您正在搜索字符串,或者正在搜索多字节模式,则InstrB正常工作。
PosEnd = InstrB(PosBeg,ByteArray,chrb(13))
在我的破碎的系统上,即使在位置1没有字节值13,这个函数总是返回1,当搜索字节数组时,它返回1。经典的ASP文件上传组件,这就是为什么我们都在这个线程上,遇到这种情况,因为他们正在解析字节数组寻找分隔符。
PosEnd = InstrB(PosBeg,getByteString("FormBoundary")) PosEnd = InstrB(PosBeg,getByteString(vbCRLF)) PosEnd = InstrB(PosBeg,"Normal string",chrb(103)) ' Search for letter g in a string
这些以上线条正常工作正常。预期多字节搜索和匹配字符串工作。
昨天晚上,这个问题同时发生在多台服务器上。我看到Windows系统的更新也在晚上跑了。缩小,我发现MS15-124(KB3104002 IE11的累积安全更新)包含vbscript.dll的更新。我删除了这个更新,现在代码恢复正常工作。
我提交了一个问题在他们的“IE连接”系统,因为它被包括在一个IE更新,但我不知道这是否是正确的地方。
我附上了一个测试用例。在破碎的系统上,它将返回“5,1,5”。在工作系统上,将返回“5,5,5”
希望修复这些旧代码中的一些在我无法访问的系统上运行。
' 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,chrb(111)) ResponseText = ResponseText + "Position in byte array: " & bPosition & vbCRLF bPosition = instrb(1,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