VBA通过POST方法将二进制代码文件发送到API

Question

我的代码有最后一个问题。通过 POST 变量将代码从 Outlook 发送到 API。

我的最后一个问题是如何在一个 POST 请求中向 API 发送变量和邮件附件。

邮件附件的第一个 7zip 压缩：

strSource = cstrFileAttachment & "*.*"
strTarget = cstrFileattachment & "Zip\attachment.zip"
strPassword = randomPassword(cintLongPassword)
strCommand = """" & PathZipProgram & """ a -tzip """ & strTarget & _
    """ -p" & strPassword & " """ & strSource & """"

现在我有c:\attachment\attachment.zip

下一部分是将变量发送到 API：

    Dim SendDataToApi As String


    strFrom = 1


    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")

    URL = "https://url.domain.com/api/data"

    objHTTP.Open "POST", URL, False
    objHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"


    SendDataToApi = "mail_from=" & strFrom & "&mail_to=" & strKomu & "&file_attachment=" & fileAttachment & "&url_attribute=" & strWebLink & "&sms_code=" & strHeslo & "&id_message=" & IdMessage & "&mobile_phone=" & strPhone & "&date_send=" & strDateSend & "&date_expiration=" & strDateExp

    objHTTP.Send SendDataToApi

发送变量，但fileAttachment作为字符串发送，因此API获取保存文件的路径。

我的问题是如何将下面的代码（在互联网上找到）实现到我的代码sendDataToApi 和 POST attachment.zip 作为二进制字符串而不是字符串。

    Private Function Upload(strUploadUrl, strFilePath, strFileField, strDataPairs)
    'Uses POST to upload a file and miscellaneous form data
    strUploadUrl = "https://url.domain.com/api/data"
    strFilePath = cstrFilepathAttachment & "Zip\attachment.zip"
    'strFileField is the web page equivalent form field name for the file (File1)
    'strDataPairs are pipe-delimited form data pairs (foo=bar|snap=crackle)
    Const MULTIPART_BOUNDARY = "---------------------------0123456789012"
    Dim ado, rs
    Dim lngCount
    Dim bytFormData, bytFormStart, bytFormEnd, bytFile
    Dim strFormStart, strFormEnd, strDataPair
    Dim web
    Const adLongVarBinary = 205
        'Read the file into a byte array
        Set ado = CreateObject("ADODB.Stream")
        ado.Type = 1
        ado.Open
        ado.LoadFromFile strFilePath
        bytFile = ado.Read
        ado.Close
        'Create the multipart form data.
        'Define the end of form
        strFormEnd = vbCrLf & "--" & MULTIPART_BOUNDARY & "--" & vbCrLf
        'First add any ordinary form data pairs
        strFormStart = ""
        For Each strDataPair In Split(strDataPairs, "|")
            strFormStart = strFormStart & "--" & MULTIPART_BOUNDARY & vbCrLf
            strFormStart = strFormStart & "Content-Disposition: form-data; "
            strFormStart = strFormStart & "name=""" & Split(strDataPair, "=")(0) & """"
            strFormStart = strFormStart & vbCrLf & vbCrLf
            strFormStart = strFormStart & Split(strDataPair, "=")(1)
            strFormStart = strFormStart & vbCrLf
        Next
        'Now add the header for the uploaded file
        strFormStart = strFormStart & "--" & MULTIPART_BOUNDARY & vbCrLf
        strFormStart = strFormStart & "Content-Disposition: form-data; "
        strFormStart = strFormStart & "name=""" & strFileField & """; "
        strFormStart = strFormStart & "filename=""" & Mid(strFilePath, InStrRev(strFilePath, "\") + 1) & """"
        strFormStart = strFormStart & vbCrLf
        strFormStart = strFormStart & "Content-Type: application/upload" 'bogus, but it works
        strFormStart = strFormStart & vbCrLf & vbCrLf
        'Create a recordset large enough to hold everything
        Set rs = CreateObject("ADODB.Recordset")
        rs.Fields.Append "FormData", adLongVarBinary, Len(strFormStart) + LenB(bytFile) + Len(strFormEnd)
        rs.Open
        rs.AddNew
        'Convert form data so far to zero-terminated byte array
        For lngCount = 1 To Len(strFormStart)
            bytFormStart = bytFormStart & ChrB(Asc(Mid(strFormStart, lngCount, 1)))
        Next
        rs("FormData").AppendChunk bytFormStart & ChrB(0)
        bytFormStart = rs("formData").GetChunk(Len(strFormStart))
        rs("FormData") = ""
        'Get the end boundary as a zero-terminated byte array
        For lngCount = 1 To Len(strFormEnd)
            bytFormEnd = bytFormEnd & ChrB(Asc(Mid(strFormEnd, lngCount, 1)))
        Next
        rs("FormData").AppendChunk bytFormEnd & ChrB(0)
        bytFormEnd = rs("formData").GetChunk(Len(strFormEnd))
        rs("FormData") = ""
        'Now merge it all
        rs("FormData").AppendChunk bytFormStart
        rs("FormData").AppendChunk bytFile
        rs("FormData").AppendChunk bytFormEnd
        bytFormData = rs("FormData")
        rs.Close
        'Upload it
        Set web = CreateObject("WinHttp.WinHttpRequest.5.1")
        web.Open "POST", strUploadUrl, False
        web.SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & MULTIPART_BOUNDARY
        web.Send bytFormData
    End Function

更新：

当我从@Tim Williams 添加部分代码时

在我的数据库中保存文件为/tmp/phpAJOtVw 我做错了什么？

Answer 1

Upload 是一个独立的方法，所以你应该可以这样称呼它：

sUrl = "https://url.domain.com/api/data"  'API endpoint

fPath = "c:\attachment\attachment.zip"    'attachment location

FileFieldName = "checkYourApiForThis"     'API specifies this

DataPairs = "mail_from=" & strFrom & _
                "&mail_to=" & strKomu & _
                "&file_attachment=" & fileAttachment & _
                "&url_attribute=" & strWebLink & _
                "&sms_code=" & strHeslo & _
                "&id_message=" & IdMessage & _
                "&mobile_phone=" & strPhone & _
                "&date_send=" & strDateSend & _
                "&date_expiration=" & strDateExp

'call the function
'expects |-delimited name/value pairs, not &, so do a replace
Upload sUrl, fPath, FileFieldName, Replace(DataPairs, "&", "|")

您应该从Upload 的顶部删除这些硬编码值：

strUploadUrl = "https://url.domain.com/api/data"
strFilePath = cstrFilepathAttachment & "Zip\attachment.zip"