经典ASP中VBScript直传远程图片到S3存储桶报错排查

报错是因为你通过ADODB.Stream读取返回的二进制数组，不符合InAmazon.S3组件要求的一维VT_UI1类型字节数组格式。
你处理表单上传图片时不报错，是因为表单上传组件解析出的二进制数据本身就是标准COM兼容的一维字节数组；而你现在的url_to_stream函数里，把XMLHTTP返回的二进制写入Stream后再调用无参数的Read()方法返回，在Classic ASP的COM封送逻辑里，这种无参数Read返回的数组经常会被标记为非安全数组/多维数组变体，S3组件识别不了就会抛错。
另外你现有代码还有两个隐藏bug：

• 正则提取的图片src很多是相对路径，直接发请求会404，直接当S3对象名也会带非法路径
• 循环里判断子匹配用的是固定的oMatches(0)，不是当前遍历的匹配项，会出现漏抓、错抓

修复方案 #

核心修复：去掉多余的Stream转存逻辑 #

XMLHTTP请求成功后返回的responseBody本身就是标准的一维字节数组，完全符合InAmazon.S3的参数要求，不需要经过ADODB.Stream转一道，从根源避免类型不匹配问题。

补充修复： #

1. 提前定义adTypeBinary常量，避免ADO常量未定义报错
2. 补全图片相对路径为绝对可访问的URL
3. 提取纯文件名作为S3上传的对象键，避免路径非法
4. 修正循环内的匹配项判断逻辑

修正后可运行代码 #

' 提前定义ADO常量，避免未定义错误
Const adTypeBinary = 1
remoteurl = "https://some-website-with-images/"

Set AWS = Server.CreateObject("InAmazon.S3")
AWS.AccessKey = AWS_ACCESS_KEY
AWS.SecretKey = AWS_SECRET
AWS.Config("Url=http://s3-ap-southeast-2.amazonaws.com")
AWS.Bucket = "bucket-name"

Set http = Server.CreateObject ("MSXML2.XMLHTTP.6.0")
http.Open "GET", remoteurl, False
http.Send

Set re = New RegExp
' 修正正则，正确匹配img标签的src属性
re.Pattern = "<img[^>]*src=[""']([^""'>]+\.(jpg|png))[""']"
re.IgnoreCase = True
re.Global = True
re.Multiline = True
Set oMatches = re.Execute(http.responseText)

If oMatches.Count > 0 Then
    Dim oMatch, imgUrl, s3Key, binaryImg
    For Each oMatch In oMatches
        ' 提取当前匹配项的图片地址
        imgUrl = oMatch.SubMatches(0)
        
        ' 补全相对路径为绝对URL
        If Left(imgUrl, 2) = "//" Then
            imgUrl = "https:" & imgUrl
        ElseIf Left(imgUrl, 1) = "/" Then
            imgUrl = GetRootDomain(remoteurl) & imgUrl
        ElseIf InStr(1, imgUrl, "http", vbTextCompare) <> 1 Then
            imgUrl = Left(remoteurl, InStrRev(remoteurl, "/")) & imgUrl
        End If
        
        ' 提取纯文件名作为S3对象键
        s3Key = Mid(imgUrl, InStrRev(imgUrl, "/") + 1)
        
        ' 读取图片二进制
        binaryImg = GetImageBinary(imgUrl)
        If Not IsNull(binaryImg) Then
            AWS.objectDataB = binaryImg
            AWS.createObject(s3Key)
        End If
    Next
End If

' 修正后的二进制读取函数，直接返回标准一维字节数组
Function GetImageBinary(imageUrl)
    On Error Resume Next
    Dim xml
    Set xml = Server.CreateObject("MSXML2.XMLHTTP.6.0")
    xml.Open "GET", imageUrl, False
    xml.Send
    If Err.Number = 0 And xml.readyState = 4 And xml.status = 200 Then
        ' 直接返回responseBody，无需Stream转存
        GetImageBinary = xml.responseBody
    Else
        GetImageBinary = Null
    End If
    Set xml = Nothing
    Err.Clear
End Function

' 辅助方法：提取URL根域名，用于拼接根路径相对地址
Function GetRootDomain(url)
    Dim slashPos
    slashPos = InStr(8, url, "/")
    If slashPos > 0 Then
        GetRootDomain = Left(url, slashPos - 1)
    Else
        GetRootDomain = url
    End If
End Function

如果你后续有图片处理需求必须用ADODB.Stream（比如裁剪、加水印），读取时一定要显式传入Stream总长度作为Read参数，不要无参数调用Read，否则还是会出现数组类型不匹配问题：

oStream.Position = 0
' 显式指定读取长度，返回数组类型才会符合要求
binaryImg = oStream.Read(oStream.Size)

内容的提问来源于stack exchange，提问作者Benzine