VBA 上传图片

问题来源于帖子：VBA怎么样通过winHttp、xmlHttp post上传图片呢 求大佬指点

整个过程并没有什么加密，比较简单，就不做什么分析了，使用Fiddler抓包查看，可以很快的用python复现

import requests
from io import BytesIO
from requests_toolbelt.multipart.encoder import MultipartEncoder

def main():
    file_name = '6da2ddc8124d0ba7045c38925eb857c0.jpeg'
    fields = {
    
        "image": (file_name, BytesIO(open(file_name, 'rb').read()), 'image/jpeg'),
        "fileId": file_name,
        "initialPreview": '[]',
        "initialPreviewConfig": '[]',
        "initialPreviewThumbTags": '[]'
    }
    multipart = MultipartEncoder(
        fields=fields,
        boundary='----WebKitFormBoundaryAx0QwuMECh2eIreV'
    )
    headers = {
    
        "X-Requested-With": "XMLHttpRequest",
        "Content-Type": multipart.content_type,
    }
    data = multipart.to_string()
    response = requests.post('https://www.imgtp.com/upload/upload.html', headers=headers, data=data)
    print(response.status_code)
    print(response.headers)
    print(response.request.headers)
    print(response.json())


if __name__ == '__main__':
    main()

基本上都是照抄，最后可以获取在线的图片地址。这么难点在于如何使用VBA来上传。
1.因为没有轮子，所有multipart 包装需要自己处理。
2.请求体包含了二进制文件

一、
为了解决第一个问题，可以在vba中生成的二进制数据（即Byte数组）与python的对比，直到两个数据完全一样。

二、因为要提交字节数组，那么必须要使用【WinHttp.WinHttpRequest.5.1】对象。

提交部分的代码如下

Sub upload()
    Const Boundary As String = "----WebKitFormBoundaryAx0QwuMECh2eIreV"
    Const file_name As String = "6da2ddc8124d0ba7045c38925eb857c0.jpeg"
    Dim image_byte() As Byte
    Dim data() As Byte
    image_byte = openbytefile(ActiveWorkbook.path & "\" + file_name)
    Dim bytes As bytearray
    Set bytes = New bytearray
    
    bytes.update encodeutf8("--" & Boundary & vbNewLine)
    bytes.update encodeutf8("Content-Disposition: form-data; name=""image""; filename=""" & file_name & """" & vbNewLine)
    bytes.update encodeutf8("Content-Type: image/jpeg" & vbNewLine)
    bytes.update encodeutf8(vbNewLine)
    bytes.update image_byte
    bytes.update encodeutf8(vbNewLine)
    
    bytes.update encodeutf8("--" & Boundary & vbNewLine)
    bytes.update encodeutf8("Content-Disposition: form-data; name=""fileId""" & vbNewLine)
    bytes.update encodeutf8(vbNewLine & vbNewLine)
    bytes.update encodeutf8(file_name & vbNewLine)
    
    bytes.update encodeutf8("--" & Boundary & vbNewLine)
    bytes.update encodeutf8("Content-Disposition: form-data; name=""initialPreview""" & vbNewLine)
    bytes.update encodeutf8(vbNewLine & vbNewLine)
    bytes.update encodeutf8("[]" & vbNewLine)
    
    bytes.update encodeutf8("--" & Boundary & vbNewLine)
    bytes.update encodeutf8("Content-Disposition: form-data; name=""initialPreviewConfig""" & vbNewLine)
    bytes.update encodeutf8(vbNewLine & vbNewLine)
    bytes.update encodeutf8("[]" & vbNewLine)
    
    bytes.update encodeutf8("--" & Boundary & vbNewLine)
    bytes.update encodeutf8("Content-Disposition: form-data; name=""initialPreviewThumbTags""" & vbNewLine)
    bytes.update encodeutf8(vbNewLine & vbNewLine)
    bytes.update encodeutf8("[]" & vbNewLine)
    
    bytes.update encodeutf8("--" & Boundary & "--" & vbNewLine)
    
    data = bytes.digest
    
    Dim http As Object
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    Dim htmlurl As String
    htmlurl = "https://www.imgtp.com/upload/upload.html"
    Dim htmltext As String
    
    With http
        .Open "POST", htmlurl, False
        .SetRequestHeader "User-Agent", "python-requests/2.25.1"
        .SetRequestHeader "Accept-Encoding", "gzip, deflate"
        .SetRequestHeader "Accept", "*/*"
        .SetRequestHeader "Connection", "keep-alive"
        .SetRequestHeader "X-Requested-With", "XMLHttpRequest"
        .SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & Boundary
        .SetRequestHeader "Content-Length", CStr(UBound(data) + 1)
        .Send data
        Dim body() As Byte
        body = .responseBody
        htmltext = encoding(body, "utf-8")
    End With
    
    Debug.Print htmltext
End Sub

这里我自己写了一个类，为了方便拼接二进制数据

Option Explicit

Private data() As Byte


Public Sub Class_Initialize()
    ReDim data(0 To 0)
End Sub


Public Sub update(body() As Byte)
    ReDim Preserve data(0 To (UBound(data) - LBound(data) + UBound(body) - LBound(body) + 1))
    Dim i As Long
    For i = UBound(body) To 0 Step -1
        data(UBound(data) - i) = body(UBound(body) - i)
    Next i
End Sub


Public Property Get digest() As Byte()
    Dim temp() As Byte
    ReDim temp(0 To UBound(data) - 1)
    Dim i As Long
    For i = 1 To UBound(data) Step 1
        temp(i - 1) = data(i)
    Next i
    digest = temp
End Property


Public Sub Class_Terminate()
    ReDim data(0 To 0)
End Sub

更多内容可以加入我的星球