以经典方式上传文件 asp
Uploading a file in classic asp
我一直使用以下脚本在经典 asp 中上传文件，但它停止工作并出现此错误
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,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
此代码在每个项目中一直都能正常运行，但现在却无法在所有项目中正常运行。所以我不能只是编辑和使用另一个功能，我需要了解为什么它不再起作用
尝试使用此上传代码（归功于 Lewis Moten）：http://planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=8525&lngWId=4
我最近 运行 在将站点迁移到较新版本的 Windows 服务器时遇到了同样的问题。使用 Lewis Moten 的上传代码解决了这个问题。
万一 link 死了，代码也发布在 this answer。
修复 #1 - 卸载 "KB3104002 Cumulative security update for 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 - Microsoft 已发布修补程序。这将在 2016 年 1 月向所有人发布。您可以在这里提前获得。 https://support.microsoft.com/en-us/kb/3125446
问题似乎是 vbScript 中的 InstrB 函数现在 return在以下条件下的值为 1。
- 当您搜索 字节数组时 （例如 Response.BinaryRead）。这在 ASP 或 VBScript 中不是很常见，但文件上传是您执行此操作的时候之一。
- 当您搜索单个字节时
如果您正在搜索字符串，或者如果您正在搜索多字节模式，那么 InstrB 可以正常工作。
PosEnd = InstrB(PosBeg, ByteArray, chrb(13))
在我损坏的系统上，此函数始终 return 为 1，即使在位置 1 处没有字节值 13。它 return 在搜索字节数组时对任何值都为 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（IE11 的 KB3104002 累积安全更新）包含 vbscript.dll 的更新。我删除了这个更新，现在代码 returns 可以正常工作了。
我在他们的 "IE Connect" 系统上提交了一个问题，因为它包含在 IE 更新中，但我不确定那是否是正确的地方。
我附上了一个测试用例。在损坏的系统上，它将 return "5, 1, 5"。在工作系统上它将 return "5, 5, 5"
希望修复。一些旧代码 运行ning 在我无法访问的系统上。
' 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:
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 中遇到了同样的问题，InStrB 突然返回 1，即使我在调试器中验证它不应该，即有问题的字符在位置 17。
我为 InStrB 编写了以下替换函数（仅在查找 1 个字符时使用）。我是一个蹩脚的 VBS 程序员，所以，请随意清理它。但它似乎确实有效...
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
由于代表率低，我无法回复原始评论，但如果您无法像我那样使用正常的控制面板方法删除更新（它没有出现在列表中卸载量）这是使用 Powershell 和命令行执行此操作的方法：
卸载的临时解决方法"KB3104002 Cumulative security update for IE11"：
执行以下操作以检查是否安装了更新：
- 点击 Windows 键（或右键单击 Windows 按钮等）并输入 `cmd` 并按回车键。
- 键入 `powershell` 并按回车键。
- 使用命令 `get-hotfix -id KB3104002` 查看是否安装了更新。如果是，您将看到返回的列表以及此更新的安装日期。
如果安装了更新，继续：
- 如果您仍在 powershell 中，请输入 `exit` 离开。
- 使用命令`wusa /uninstall /kb:3104002`卸载补丁
- 重启！
警告：KB3104002 is listed as a "Critical Security Update" according to Microsoft 所以我不建议永远忽略此更新，但作为此更新引起的问题的临时解决方案，这就是我选择做的事情。我认为 Microsoft 将发布此更新的更新，处理它显然造成的大屠杀 ASP 代码仍在使用中。
Microsoft 已发布修补程序来修复此问题。
我一直使用以下脚本在经典 asp 中上传文件，但它停止工作并出现此错误
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,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
此代码在每个项目中一直都能正常运行，但现在却无法在所有项目中正常运行。所以我不能只是编辑和使用另一个功能，我需要了解为什么它不再起作用
尝试使用此上传代码（归功于 Lewis Moten）：http://planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=8525&lngWId=4
我最近 运行 在将站点迁移到较新版本的 Windows 服务器时遇到了同样的问题。使用 Lewis Moten 的上传代码解决了这个问题。
万一 link 死了，代码也发布在 this answer。
修复 #1 - 卸载 "KB3104002 Cumulative security update for 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 - Microsoft 已发布修补程序。这将在 2016 年 1 月向所有人发布。您可以在这里提前获得。 https://support.microsoft.com/en-us/kb/3125446
问题似乎是 vbScript 中的 InstrB 函数现在 return在以下条件下的值为 1。
- 当您搜索 字节数组时 （例如 Response.BinaryRead）。这在 ASP 或 VBScript 中不是很常见，但文件上传是您执行此操作的时候之一。
- 当您搜索单个字节时
如果您正在搜索字符串，或者如果您正在搜索多字节模式，那么 InstrB 可以正常工作。
PosEnd = InstrB(PosBeg, ByteArray, chrb(13))
在我损坏的系统上，此函数始终 return 为 1，即使在位置 1 处没有字节值 13。它 return 在搜索字节数组时对任何值都为 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（IE11 的 KB3104002 累积安全更新）包含 vbscript.dll 的更新。我删除了这个更新，现在代码 returns 可以正常工作了。
我在他们的 "IE Connect" 系统上提交了一个问题，因为它包含在 IE 更新中，但我不确定那是否是正确的地方。
我附上了一个测试用例。在损坏的系统上，它将 return "5, 1, 5"。在工作系统上它将 return "5, 5, 5"
希望修复。一些旧代码 运行ning 在我无法访问的系统上。
' 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:
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 中遇到了同样的问题，InStrB 突然返回 1，即使我在调试器中验证它不应该，即有问题的字符在位置 17。
我为 InStrB 编写了以下替换函数（仅在查找 1 个字符时使用）。我是一个蹩脚的 VBS 程序员，所以，请随意清理它。但它似乎确实有效...
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
由于代表率低，我无法回复原始评论，但如果您无法像我那样使用正常的控制面板方法删除更新（它没有出现在列表中卸载量）这是使用 Powershell 和命令行执行此操作的方法：
卸载的临时解决方法"KB3104002 Cumulative security update for IE11"：
执行以下操作以检查是否安装了更新：
- 点击 Windows 键（或右键单击 Windows 按钮等）并输入 `cmd` 并按回车键。
- 键入 `powershell` 并按回车键。
- 使用命令 `get-hotfix -id KB3104002` 查看是否安装了更新。如果是，您将看到返回的列表以及此更新的安装日期。
如果安装了更新，继续：
- 如果您仍在 powershell 中，请输入 `exit` 离开。
- 使用命令`wusa /uninstall /kb:3104002`卸载补丁
- 重启！
警告：KB3104002 is listed as a "Critical Security Update" according to Microsoft 所以我不建议永远忽略此更新，但作为此更新引起的问题的临时解决方案，这就是我选择做的事情。我认为 Microsoft 将发布此更新的更新，处理它显然造成的大屠杀 ASP 代码仍在使用中。
Microsoft 已发布修补程序来修复此问题。