如何用VBS实现带参数的HTTP POST文件上传？

我明白你现在的困境——好久没碰VBS，刚接触HTTP协议，想同时传参数和文件却卡壳了。你说得对，不能调用两次.Send方法，而且你的Content-Type设置也冲突了，multipart/form-data格式本身就支持同时包含普通表单参数和文件，不需要分开处理。

核心思路 #

multipart/form-data请求体由多个独立的"部分"组成，每个部分用你定义的strBoundary分隔：

1. 一个部分用来传递普通参数（比如publication=moveit_test_pub）
2. 另一个部分用来传递文件内容
3. 所有部分整合到同一个ADODB.Stream中，生成完整的请求体后一次发送

修改后的关键代码解析 #

1. 构建包含参数和文件的请求体

这部分是核心，我们把参数和文件都加入到Stream中：

' 生成随机边界（确保不会和内容冲突）
strBoundary = String(6, "-") & Replace(Mid(CreateObject("Scriptlet.TypeLib").Guid, 2, 36), "-", "")

With CreateObject("ADODB.Stream")
    .Mode = 3
    .Charset = "Windows-1252"
    .Open
    .Type = 2 ' 先以文本模式写入边界和表单字段

    ' 写入普通参数部分：publication=moveit_test_pub
    .WriteText "--" & strBoundary & vbCrLf
    .WriteText "Content-Disposition: form-data; name=""publication""" & vbCrLf & vbCrLf
    .WriteText "moveit_test_pub" & vbCrLf

    ' 写入文件部分
    .WriteText "--" & strBoundary & vbCrLf
    .WriteText "Content-Disposition: form-data; name=""file""; filename=""" & strFile & """" & vbCrLf
    .WriteText "Content-Type: " & strContentType & vbCrLf & vbCrLf
    .Position = 0 ' 切换到二进制模式前，指针移到开头
    .Type = 1
    .Position = .Size ' 移到当前内容末尾，准备写入文件二进制数据
    .Write bytData ' 写入文件内容

    ' 写入结束边界
    .Position = .Size ' 移到文件数据末尾
    .Type = 2 ' 切回文本模式
    .WriteText vbCrLf & "--" & strBoundary & "--" & vbCrLf

    .Position = 0
    .Type = 1
    bytPayLoad = .Read ' 读取完整的请求体
End With

2. 发送请求（仅一次Send）

删除重复的Content-Type设置，只保留multipart/form-data，然后发送整合好的请求体：

With CreateObject("MSXML2.ServerXMLHTTP")
    .setOption 2, 13056 ' 仅测试用：忽略SSL证书错误
    .SetTimeouts 0, 60000, 300000, 300000
    .Open "POST", "https://192.168.100.100/api/import_file_here.json", False
    ' 只设置一次正确的Content-Type
    .SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & strBoundary
    .Send bytPayLoad ' 一次发送完整请求体

    ' 处理响应
    If Err.Number <> 0 Then
        strStatus = Err.Description & " (" & Err.Number & ")"
    Else
        strStatus = .StatusText & " (" & .Status & ")"
        strResponse = .ResponseText
    End If
End With

完整修改后的代码 #

strFilePath = "C:\SCAudience_TEST5.txt"
UploadFile strFilePath, strUplStatus, strUplResponse
MsgBox strUplStatus & vbCrLf & strUplResponse

Sub UploadFile(strPath, strStatus, strResponse)
    Dim strFile, strExt, strContentType, strBoundary, bytData, bytPayLoad
    On Error Resume Next

    ' 检查文件是否存在
    With CreateObject("Scripting.FileSystemObject")
        If .FileExists(strPath) Then
            strFile = .GetFileName(strPath)
            strExt = .GetExtensionName(strPath)
        Else
            strStatus = "File not found"
            Exit Sub
        End If
    End With

    ' 映射文件类型到标准Content-Type
    With CreateObject("Scripting.Dictionary")
        .Add "txt", "text/plain"
        .Add "html", "text/html"
        .Add "php", "application/x-php"
        .Add "js", "application/x-javascript"
        .Add "vbs", "application/x-vbs"
        .Add "bat", "application/x-bat"
        .Add "jpeg", "image/jpeg"
        .Add "jpg", "image/jpeg"
        .Add "png", "image/png"
        .Add "exe", "application/octet-stream" ' 修正exe的标准Content-Type
        .Add "doc", "application/msword"
        .Add "docx", "application/vnd.openxmlformats-officedocument.wordprocessingml.document"
        .Add "xls", "application/vnd.ms-excel"
        .Add "xlsx", "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
        
        If .Exists(LCase(strExt)) Then
            strContentType = .Item(LCase(strExt))
        Else
            strStatus = "Invalid file type"
            Exit Sub
        End If
    End With

    ' 读取文件为二进制数据
    With CreateObject("ADODB.Stream")
        .Type = 1
        .Mode = 3
        .Open
        .LoadFromFile strPath
        If Err.Number <> 0 Then
            strStatus = Err.Description & " (" & Err.Number & ")"
            Exit Sub
        End If
        bytData = .Read
        .Close
    End With

    ' 生成随机边界
    strBoundary = String(6, "-") & Replace(Mid(CreateObject("Scriptlet.TypeLib").Guid, 2, 36), "-", "")

    ' 构建multipart/form-data请求体
    With CreateObject("ADODB.Stream")
        .Mode = 3
        .Charset = "Windows-1252"
        .Open
        .Type = 2 ' 文本模式写入表单字段和边界

        ' 添加普通参数：publication
        .WriteText "--" & strBoundary & vbCrLf
        .WriteText "Content-Disposition: form-data; name=""publication""" & vbCrLf & vbCrLf
        .WriteText "moveit_test_pub" & vbCrLf

        ' 添加文件字段
        .WriteText "--" & strBoundary & vbCrLf
        .WriteText "Content-Disposition: form-data; name=""file""; filename=""" & strFile & """" & vbCrLf
        .WriteText "Content-Type: " & strContentType & vbCrLf & vbCrLf
        
        ' 切换到二进制模式写入文件内容
        .Position = 0
        .Type = 1
        .Position = .Size ' 移到当前内容末尾
        .Write bytData

        ' 写入结束边界
        .Position = .Size
        .Type = 2
        .WriteText vbCrLf & "--" & strBoundary & "--" & vbCrLf

        ' 读取完整的请求体
        .Position = 0
        .Type = 1
        bytPayLoad = .Read
        .Close
    End With

    ' 发送请求
    With CreateObject("MSXML2.ServerXMLHTTP")
        .setOption 2, 13056 ' 仅测试环境使用：忽略SSL证书错误
        .SetTimeouts 0, 60000, 300000, 300000
        .Open "POST", "https://192.168.100.100/api/import_file_here.json", False
        .SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & strBoundary
        .Send bytPayLoad

        ' 处理响应
        If Err.Number <> 0 Then
            strStatus = Err.Description & " (" & Err.Number & ")"
        Else
            strStatus = .StatusText & " (" & .Status & ")"
            strResponse = .ResponseText
        End If
        .Close
    End With
End Sub

额外说明 #

• setOption 2, 13056是用来忽略SSL证书错误的，仅适合测试环境，生产环境请使用合法的SSL证书
• 每个form-data部分必须以--boundary开头，最后以--boundary--结束，这是multipart/form-data格式的强制要求
• 普通参数只需要指定name属性，文件参数需要同时指定name和filename，并标注正确的Content-Type

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