VBA中SendWinHttpRequest发送POST请求时请求体无法传递的问题

为处理大量记录避免内存溢出，我选用WinHTTP原生API替代不支持分块处理的XMLHttp60/ServerXMLHttp60/WinHttpRequest库。目前连接初始化、JWT Bearer Token发送均正常，但WinHttpSendRequest无法传递请求体，服务端仅返回错误响应；尝试用WinHttpWriteData时写入字节数始终为0，调整请求头也无效果。服务端为Node.js Express，完全接收不到JSON数据。我已尝试将JSON字符串转为字节数组，但问题仍未解决。

以下是相关API声明及代码片段：

WinHTTP API声明 #

'GetLastError - 很少返回有用信息，大多是0
Private Declare PtrSafe Function GetLastError Lib "kernel32" () As Long
' WinHTTP库API函数声明
Private Declare PtrSafe Function WinHttpAddRequestHeaders Lib "WinHttp" (ByVal hRequest As LongPtr, ByVal sHeader As LongPtr, ByVal lHeaderLength As Long, ByVal lModifiers As Long) As Boolean
Private Declare PtrSafe Function WinHttpOpen Lib "WinHttp" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As LongPtr
Private Declare PtrSafe Function WinHttpConnect Lib "WinHttp" (ByVal hSession As LongPtr, ByVal pswzServerName As LongPtr, ByVal nServerPort As Long, ByVal dwReserved As Long) As LongPtr
Private Declare PtrSafe Function WinHttpCloseHandle Lib "WinHttp" (ByVal hHandle As LongPtr) As Boolean
Public Declare PtrSafe Function WinHttpSetOption Lib "WinHttp" (ByVal hInternet As LongPtr, ByVal lOption As Long, ByRef lBuffer As LongPtr, ByVal lBufferLength As Long) As Boolean
Private Declare PtrSafe Function WinHttpOpenRequest Lib "WinHttp" (ByVal hHttpSession As LongPtr, ByVal sVerb As LongPtr, ByVal sObjectName As LongPtr, ByVal VersionTuple As LongPtr, ByVal sReferer As LongPtr, ByVal sAcceptTypes As Long, ByVal lFlags As Long) As LongPtr
Private Declare PtrSafe Function WinHttpSendRequest Lib "WinHttp" (ByVal hRequest As LongPtr, ByVal sHeaders As LongPtr, ByVal lHeadersLength As Long, ByVal sOptional As LongPtr, ByVal lOptionalLength As Long, ByVal lTotalLength As Long, ByVal lContext As Long) As Boolean
Private Declare PtrSafe Function WinHttpReceiveResponse Lib "WinHttp" (ByVal hRequest As LongPtr, ByVal lReserved As Long) As Boolean
Private Declare PtrSafe Function WinHttpQueryDataAvailable Lib "WinHttp" (ByVal hRequest As LongPtr, ByRef lNumberOfBytesAvailable As Long) As Boolean
Private Declare PtrSafe Function WinHttpReadData Lib "WinHttp" (ByVal hRequest As LongPtr, ByVal sBuffer As String, ByVal lNumberOfBytesToRead As Long, ByRef lNumberOfBytesRead As Long) As Boolean
Private Declare PtrSafe Function WinHttpWriteData Lib "WinHttp" (ByVal hRequest As LongPtr, ByVal lpBuffer As LongPtr, ByVal dwNumberOfBytesToWrite As Long, ByVal lpdwNumberOfBytesWritten As Long) As Boolean

请求处理代码片段 #

Dim authHeader As String
authHeader = "Authorization: Bearer " & token

Dim headersset As Boolean
'headersset = WinHttpAddRequestHeaders(hHttpRequest, StrPtr(authHeader), Len(authHeader), &H20000000)
'If headersset = False Then Stop
Dim contentheader As String
contentheader = "Content-Length: " & LenB(json)
'headersset = WinHttpAddRequestHeaders(hHttpRequest, StrPtr(contentheader), Len(contentheader), &H20000000)
'If headersset = False Then Stop

Dim contenttype As String
contenttype = "Content-Type:'application/json'"
'contenttype = "Content-Type: application/x-www-form-urlencoded"
'headersset = WinHttpAddRequestHeaders(hHttpRequest, StrPtr(contenttype), Len(contenttype), &H20000000)
'If headersset = False Then Stop

Dim accepttype As String
accepttype = "Accept:'application/json'"
'headersset = WinHttpAddRequestHeaders(hHttpRequest, StrPtr(accepttype), Len(accepttype), &H20000000)
'If headersset = False Then Stop

'Dim encodingheader As String
'encodingheader = "Transfer-Encoding: chunked"
'headersset = WinHttpAddRequestHeaders(hHttpRequest, StrPtr(encodingheader), Len(encodingheader), &H20000000)
'If headersset = False Then Stop


header = authHeader & vbCrLf & contentheader & vbCrLf & contenttype & vbCrLf & accepttype & vbCrLf

If WinHttpSendRequest(hHttpRequest, StrPtr(header), Len(header), StrPtr(json), Len(json), Len(json), 0) Then
    ' 后续有时会调用WinHttpWriteData
    ' ...
    ' WinHttpQueryDataAvailable / WinHttpReadData工作正常，至少能获取错误响应
    ' ...
End If

字符串转字节数组函数 #

Function StrToBytes(ByVal str As String) As Byte()
    Dim utf8() As Byte
    utf8 = StrConv(str, vbFromUnicode)
    StrToBytes = utf8
End Function

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