Mat*_*ino 17 vbscript file-upload asp-classic
我总是使用以下脚本上传经典asp文件,但它停止工作给我这个错误
vbscript运行时错误800a01a8
对象需要'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
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
这段代码在每个项目中都能正常运行,但现在它并不适用于所有项目.所以我不能只编辑和使用其他功能,我需要了解为什么它不再起作用
Mat*_*att 21
修复#1 - 卸载"KB3104002 IE11的累积安全更新"
修复#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, inputArray, searchChar)
End If
End Function
修复#3 - 微软发布了一个修补程序.这将在2016年1月向所有人发布.您可以在这里尽早得到它.https://support.microsoft.com/en-us/kb/3125446
问题似乎是vbScript中的InstrB函数现在在以下条件下返回值1.
如果您正在搜索字符串,或者您正在搜索多字节模式,那么InstrB正常工作.
PosEnd = InstrB(PosBeg, ByteArray, chrb(13))
在我损坏的系统上,即使在位置1没有字节值13,该函数也总是返回1.在搜索字节数组时,它返回任何值的1.经典的ASP文件上传组件,这就是为什么我们都在这个线程上,遇到这种情况,因为他们正在解析那个字节数组寻找分隔符.
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
以上这些行正常工作并且符合预期.多字节搜索和匹配字符串工作预期.
这个问题昨晚在多台服务器上同时出现.我看到昨晚Windows系统更新也在运行.缩小范围,我发现MS15-124(KB3的累积安全更新KB3104002)包含vbscript.dll的更新.我删除了此更新,现在代码恢复正常工作.
我在他们的"IE Connect"系统上提出了一个问题,因为它被包含在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, 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