VBA winhttp网抓图片上传失败

不知道为什么我发送出去的数据已经和Fiddler抓取到的发送数据一样 还是返回个非法图片呢 求指点
VBA代码及附件:https://wwd.lanzoul.com/icgiA0819rlc

img


img

Sub 图床上传()
    Dim winHttp As Object, ulr As String, 数据值 As String
    Set winHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    ulr = "https://www.imgtp.com/upload/upload.html"
    gxet = GetBoundary
    字符串 = Replace(ReadTextByChatSet, "WebKitFormBoundary3lsjwD69wueqQr9V", gxet)
'    Open ThisWorkbook.Path & "\x.txt" For Output As #1
'    Print #1, 字符串
'    Close
    With winHttp
        .Open "POST", ulr, False
        .setRequestHeader "Host", "www.imgtp.com"
        .setRequestHeader "Connection", "keep-alive"
        .setRequestHeader "Content-Length", "749913"
        .setRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
        .setRequestHeader "Content-Type", "multipart/form-data; boundary=" & String(4, "-") & gxet
        .setRequestHeader "X-Requested-With", "XMLHttpRequest"
        .setRequestHeader "sec-ch-ua-mobile", "?0"
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/103.0.0.0 Safari/537.36"
        .setRequestHeader "Origin", "https://www.imgtp.com"
        .setRequestHeader "Sec-Fetch-Site", "same-origin"
        .setRequestHeader "Sec-Fetch-Mode", "cors"
        .setRequestHeader "Sec-Fetch-Dest", "empty"
        .setRequestHeader "Referer", "https://www.imgtp.com/"
        .setRequestHeader "Accept-Encoding", "gzip, deflate, br"
        .setRequestHeader "Accept-Language", "zh-CN,zh;q=0.9"
        .setRequestHeader "Cookie", "PHPSESSID=105irp0tbuqi4sdkep7t14md3t"
        .Send 字符串
        数据值 = ByteToStr(.Responsebody, "utf-8") '二进制转码utf-8
        Debug.Print 数据值
    End With
     
End Sub
Function GetBoundary() As String
    '生成Boundary
    Dim i As Integer, r As Integer
    Do While i < 16
        r = Int(Rnd * 75 + 48)
        If r < 58 Or (r > 64 And r < 91) Or r > 96 Then
            GetBoundary = GetBoundary & Chr(r)
            i = i + 1
        End If
    Loop
    GetBoundary = "WebKitFormBoundary" & GetBoundary
End Function
Function ByteToStr(arrByte, strCharset As String) As String '二进制转码
    With CreateObject("Adodb.Stream")
        .Type = 1 'adTypeBinary
        .Open
        .Write arrByte
        .Position = 0
        .Type = 2 'adTypeText
        .Charset = strCharset
        ByteToStr = .Readtext
        .Close
    End With
End Function
Function ReadTextByChatSet() '获取文本信息
    '读文件 根据文本编码格式
    Dim oStream     As Object
    Dim sText       As String
    Filename = ThisWorkbook.Path & "\111.txt"
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Charset = "gb2312" 'unicode|utf-8;Ascii; gb2312; big5; gbk
    oStream.Type = 2 'adTypeText
    oStream.LoadFromFile Filename
    ReadTextByChatSet = oStream.Readtext()
    oStream.Close
    Set oStream = Nothing
End Function

和你的文件编码方式有关,导致上传文本不完整失败了。