MSXML2.xmlhttp Отправляет пустой PDF - PullRequest
       10

MSXML2.xmlhttp Отправляет пустой PDF

0 голосов
/ 24 сентября 2018

Я пытаюсь отправить файл PDF, используя MSXML2.xmlhttp, но клиент получает пустой файл PDF в виде вложения без каких-либо ошибок.Я использую Visual Basic 6.0 для отправки запросов.

Я отправил тот же файл с RingCentral Web App, и он работает.Я думаю, что двоичное преобразование не работает должным образом.Вот мой код:

Function CreateFaxMessage(strPath, _
                          strStatus, _
                          Receiver, _
                          Optional coverPageText = "", _
                          Optional strResponse = "", _
                          Optional faxResolution As String = "High") As Boolean


        Dim strFile, strExt, strContentType, strBoundary, bytData, bytPayLoad

        On Error Resume Next

104     With CreateObject("Scripting.FileSystemObject")

106         If .FileExists(strPath) Then
108             strFile = .GetFileName(strPath)
110             strExt = .GetExtensionName(strPath)
            Else
112             strStatus = "File not found"
114             CreateFaxMessage = False

                Exit Function

            End If

        End With

116     With CreateObject("Scripting.Dictionary")
146         .Add "pdf", "application/pdf"
148         strContentType = .Item(LCase(strExt))
        End With

150     If strContentType = "" Then
152         strStatus = "Invalid file type"
154         CreateFaxMessage = False
            Exit Function
        End If


174     strBoundary = String(2, "-") & Replace(Mid(CreateObject("Scriptlet.TypeLib").Guid, 2, 36), "-", "")
    Dim nFile           As Integer
    Dim baBuffer()      As Byte
    Dim sPostData       As String

     '--- read file
    nFile = FreeFile
    Open strPath For Binary Access Read As nFile
    If LOF(nFile) > 0 Then
        ReDim baBuffer(0 To LOF(nFile) - 1) As Byte
        Get nFile, , baBuffer
        sPostData = StrConv(baBuffer, vbFromUnicode)
    End If
    Close nFile
    '--- prepare body
        sPostData = strBoundary & vbCrLf & _
        "Content-Disposition: form-data; name=""attachment""; filename=""" & strFile & """" & vbCrLf & _
        "Content-Transfer-Encoding: binary" & vbCrLf & _
        "Content-Type: " & strContentType & vbCrLf & vbCrLf & _
        sPostData & vbCrLf
        sPostData = sPostData & strBoundary & "--"

        Dim params As String

220     params = strBoundary & vbCrLf
222     params = params & "Content-Disposition: form-data; name=""faxResolution""" & vbCrLf & vbCrLf
224     params = params & faxResolution & vbCrLf

232     params = params & strBoundary & vbCrLf
        params = params & "Content-Disposition: form-data; name=""to""" & vbCrLf & vbCrLf
        params = params & Receiver & vbCrLf             

        Dim XMLHTTP As Object

218     Set XMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")

240     With XMLHTTP
242         .setTimeouts 0, 60000, 300000, 300000
244         .Open "POST", FaxURL, False
246         '.setRequestHeader "Accept", "application/json; boundary=" & strBoundary
248         .setRequestHeader "Content-Type", "multipart/form-data; boundary=" & Mid(strBoundary, 3)
250         .setRequestHeader "Authorization", "Bearer " & RingCentral.AccessToken
252         .send params & sPostData


260         If Ok(.status) Then
262             strResponse = .responseText
264             CreateFaxMessage = True

            Else
266             MsgBox .statusText & " (" & .status & ")"
            End If

        End With


        Exit Function

End Function
...