@[TOC](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
[复制链接]
发表于 2022-7-19 21:34
|
发表于 2023-3-5 11:21
