我正在尝试使用MSXML2.xmlhttp
发送PDF文件,但是客户端收到的空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