在经典asp中上传文件 [英] Uploading a file in classic asp
问题描述
我一直使用以下脚本在经典 asp 中上传文件，但它停止工作并出现此错误
I've always used the following script to upload files in classic asp, but it stopped working giving me this error
vbscript 运行时错误 800a01a8
对象需要 'Item(...)'
vbscript runtime error 800a01a8
object required 'Item(...)'
我调查了一下，我认为问题出在带有函数 BuildUploadRequest 的upload.asp 文件中，但我真的不明白为什么
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 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
上传.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
推荐答案
Fix #1 - 卸载KB3104002 IE11 累积安全更新"
Fix #1 - Uninstall "KB3104002 Cumulative security update for IE11"
修复 #2 - 将所有字节数组复制到一个字节值字符串中并对其进行处理，或者提供一个替代 instrb 来对数组进行自己的迭代.
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
修复 #3 - Microsoft 已发布修补程序.这将在 2016 年 1 月发给所有人.你可以在这里提前获得.https://support.microsoft.com/en-us/kb/3125446
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
问题似乎是 vbScript 中的 InstrB 函数现在在以下条件下返回值 1.
The problem seems to be that the InstrB function in vbScript now returns a value of 1 under the following conditions.
- 当您搜索字节数组(例如 Response.BinaryRead)时.这在 ASP 或 VBScript 中并不常见，但文件上传就是其中之一.
- 当您搜索单个字节时
- 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
如果您正在搜索一个字符串，或者您正在搜索一个多字节模式，那么 InstrB 可以正常工作.
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))
在我损坏的系统上，这个函数总是返回 1，即使在位置 1 没有字节值 13.它在搜索字节数组时为任何值返回 1.经典的 ASP 文件上传组件，这就是我们都在这个线程上的原因，会遇到这种情况，因为它们正在解析字节数组以寻找分隔符.
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.
昨晚在多个服务器上同时遇到了这个问题.我看到昨晚也运行了 Windows 系统更新.缩小范围，我发现 MS15-124(KB3104002 IE11 的累积安全更新)包含 vbscript.dll 的更新.我删除了此更新，现在代码恢复正常工作.
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.
我在他们的IE Connect"系统上提交了一个问题，因为它包含在 IE 更新中，但我不确定那是否是正确的地方.
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.
我附上了一个测试用例.在损坏的系统上，它将返回5, 1, 5".在工作系统上，它将返回5, 5, 5"
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
这篇关于在经典asp中上传文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
