使用VBA中WinINet API上传文件到Azure Blob遇错误12031

正在开发基于VBA的解决方案，通过WinINet API将文件上传至Azure Blob Storage，但调用HttpSendRequestW函数时返回错误代码12031（ERROR_INTERNET_CONNECTION_RESET），虽已添加正确请求头并处理文件数据，请求仍失败。

代码概述 #

• 使用InternetOpenW建立互联网连接
• 通过InternetConnectW连接到Azure Blob Storage
• 使用HttpOpenRequestW发起PUT请求
• 添加必要请求头（如x-ms-blob-type: BlockBlob和Content-Length）
• 调用HttpSendRequestW发送含本地文件数据的HTTP请求

问题 #

代码执行至发送请求前无错误，但HttpSendRequestW调用失败，返回错误12031（连接重置），连接配置看似正常。

已执行调试步骤 #

• 确认请求头添加正确
• 确认文件大小计算无误
• 使用InternetSetOptionW设置各类超时避免提前超时
• 文件缓冲区及其他参数均正常

核心问题 #

• 调用HttpSendRequestW时出现错误12031（Connection reset by peer）
• 已将连接、发送和接收超时设为60秒，问题仍存在

完整代码 #

Public Sub UploadFileToAzureBlob2(ByVal filePath As String, ByVal Url As String, ByVal sasUrl As String)
    Dim hInternet As Long
    Dim hConnect As Long
    Dim hRequest As Long
    Dim Buffer() As Byte
    Dim FileHandle As Integer
    Dim dwFileSize As Long

    ' Open Internet connection
    hInternet = InternetOpenW(0, INTERNET_OPEN_TYPE_DIRECT, 0, 0, 0)
    If hInternet = 0 Then
        Debug.Print "Error opening Internet: " & ERR.LastDllError
        Exit Sub
    End If

    ' Extract the server name from the URL
    Dim serverName As String
    serverName = Mid(Url, InStr(Url, "//") + 2)
    Debug.Print "Server Name: " & serverName

    ' Connect to the Azure Blob Storage URL
    hConnect = InternetConnectW(hInternet, StrPtr(serverName), _
                                INTERNET_DEFAULT_HTTPS_PORT, 0, 0, INTERNET_SERVICE_HTTP, 0, 0)
    If hConnect = 0 Then
        Debug.Print "Error connecting to URL: " & ERR.LastDllError
        InternetCloseHandle hInternet
        Exit Sub
    End If

    ' Extract the object name (container + blob name + SAS token)
    Dim objectName As String
    objectName = Mid(sasUrl, Len(Url) + 1)
    Debug.Print "Object Name: " & objectName

    ' Open an HTTP PUT request
    hRequest = HttpOpenRequestW(hConnect, StrPtr("PUT"), StrPtr(objectName), 0, 0, 0, INTERNET_FLAG_SECURE Or INTERNET_FLAG_NO_CACHE_WRITE, 0)
    If hRequest = 0 Then
        Debug.Print "Error opening request: " & ERR.LastDllError
        InternetCloseHandle hConnect
        InternetCloseHandle hInternet
        Exit Sub
    End If

    ' Read file into buffer
    FileHandle = FreeFile
    Open filePath For Binary Access Read As FileHandle
    dwFileSize = LOF(FileHandle)
    If dwFileSize = 0 Then
        Debug.Print "Error: File size is zero"
        Close FileHandle
        InternetCloseHandle hRequest
        InternetCloseHandle hConnect
        InternetCloseHandle hInternet
        Exit Sub
    End If
    ReDim Buffer(dwFileSize - 1)
    Get FileHandle, , Buffer
    Close FileHandle

    ' Add headers
    If HttpAddRequestHeadersW(hRequest, StrPtr("x-ms-blob-type: BlockBlob" & vbCrLf), _
        ByVal Len("x-ms-blob-type: BlockBlob" & vbCrLf), 0) = 0 Then
        Debug.Print "Error adding blob type header: " & ERR.LastDllError
        InternetCloseHandle hRequest
        InternetCloseHandle hConnect
        InternetCloseHandle hInternet
        Exit Sub
    End If

    ' Create the Content-Length header string
    Dim contentLength As String
    contentLength = "Content-Length: " & dwFileSize & vbCrLf

    ' Add the Content-Length header
    If HttpAddRequestHeadersW(hRequest, StrPtr(contentLength), _
        ByVal Len(contentLength) - 2, 0) = 0 Then ' Subtracting 2 for the CRLF
        Debug.Print "Error adding content length header: " & ERR.LastDllError
        InternetCloseHandle hRequest
        InternetCloseHandle hConnect
        InternetCloseHandle hInternet
        Exit Sub
    End If

    ' Set timeouts
    Dim TIMEOUT_VALUE As Long
    TIMEOUT_VALUE = 60000 ' 60 seconds timeout
    Call InternetSetOptionW(hInternet, INTERNET_OPTION_CONNECT_TIMEOUT, VarPtr(TIMEOUT_VALUE), 4)
    Call InternetSetOptionW(hInternet, INTERNET_OPTION_SEND_TIMEOUT, VarPtr(TIMEOUT_VALUE), 4)
    Call InternetSetOptionW(hInternet, INTERNET_OPTION_RECEIVE_TIMEOUT, VarPtr(TIMEOUT_VALUE), 4)

    ' Send HTTP request with file data
    If HttpSendRequestW(hRequest, 0, 0, VarPtr(Buffer(0)), dwFileSize) = 0 Then
        Debug.Print "Error sending request: " & ERR.LastDllError
        Exit Sub
    Else
        Debug.Print "File uploaded successfully!"
    End If

    ' Close handles
    InternetCloseHandle hRequest
    InternetCloseHandle hConnect
    InternetCloseHandle hInternet
    Debug.Print "Upload completed successfully!"
End Sub

解决方向及修复建议 #

1. 修正服务器名称提取逻辑 #

当前代码提取的serverName可能包含路径部分（如xxx.blob.core.windows.net/container），但InternetConnectW仅需主机名，需截取到第一个斜杠之前：

serverName = Mid(Url, InStr(Url, "//") + 2)
If InStr(serverName, "/") > 0 Then
    serverName = Left(serverName, InStr(serverName, "/") - 1)
End If

2. 调整超时设置对象 #

超时应设置在请求句柄hRequest上，而非全局连接句柄hInternet，确保请求级别的超时生效：

Call InternetSetOptionW(hRequest, INTERNET_OPTION_CONNECT_TIMEOUT, VarPtr(TIMEOUT_VALUE), 4)
Call InternetSetOptionW(hRequest, INTERNET_OPTION_SEND_TIMEOUT, VarPtr(TIMEOUT_VALUE), 4)
Call InternetSetOptionW(hRequest, INTERNET_OPTION_RECEIVE_TIMEOUT, VarPtr(TIMEOUT_VALUE), 4)

3. 优化请求头添加方式 #

• 使用LenB()获取Unicode字符串的字节数，而非Len()（字符数）
• 避免手动添加vbCrLf，改用HTTP_ADDREQ_FLAG_ADD标志让WinINet自动处理：

' 添加x-ms-blob-type头
If HttpAddRequestHeadersW(hRequest, StrPtr("x-ms-blob-type: BlockBlob"), _
    LenB("x-ms-blob-type: BlockBlob"), HTTP_ADDREQ_FLAG_ADD) = 0 Then
    Debug.Print "Error adding blob type header: " & ERR.LastDllError
    ' 关闭句柄并退出
End If

' 添加Content-Length头
contentLength = "Content-Length: " & dwFileSize
If HttpAddRequestHeadersW(hRequest, StrPtr(contentLength), _
    LenB(contentLength), HTTP_ADDREQ_FLAG_ADD) = 0 Then
    Debug.Print "Error adding content length header: " & ERR.LastDllError
    ' 关闭句柄并退出
End If

4. 增强HTTPS请求标志 #

添加INTERNET_FLAG_KEEP_CONNECTION维持连接，若测试环境证书存在问题，可临时添加INTERNET_FLAG_IGNORE_CERT_CN_INVALID（生产环境禁用）：

hRequest = HttpOpenRequestW(hConnect, StrPtr("PUT"), StrPtr(objectName), 0, 0, 0, _
    INTERNET_FLAG_SECURE Or INTERNET_FLAG_NO_CACHE_WRITE Or INTERNET_FLAG_KEEP_CONNECTION, 0)

5. 大文件分块上传 #

若上传大文件，一次性加载到内存易引发连接重置，改用HttpSendRequestExW+InternetWriteFile分块发送：

' 示例分块逻辑
Dim chunkSize As Long
chunkSize = 4096 * 1024 ' 4MB块
Dim bytesSent As Long
Dim remainingBytes As Long
remainingBytes = dwFileSize
Dim chunkBuffer() As Byte
ReDim chunkBuffer(chunkSize - 1)

' 初始化请求
Dim requestInfo As HTTP_REQUEST_INFO
requestInfo.dwStructSize = Len(requestInfo)
requestInfo.dwFlags = HTTP_REQUEST_FLAG_BYPASS_PROXY_CACHE
If HttpSendRequestExW(hRequest, requestInfo, 0, 0, 0, 0) = 0 Then
    ' 错误处理
End If

' 分块写入
Open filePath For Binary Access Read As FileHandle
Do While remainingBytes > 0
    Dim readSize As Long
    readSize = IIf(remainingBytes < chunkSize, remainingBytes, chunkSize)
    Get FileHandle, , chunkBuffer
    If InternetWriteFile(hRequest, VarPtr(chunkBuffer(0)), readSize, bytesSent) = 0 Then
        ' 错误处理
    End If
    remainingBytes = remainingBytes - bytesSent
Loop
Close FileHandle

' 结束请求
If HttpEndRequestW(hRequest, 0, 0, 0) = 0 Then
    ' 错误处理
End If

内容的提问来源于stack exchange，提问作者Adrijano Toys Shop