VBA网抓图片上传失败

颜师古都

不知道为什么我发送出去的数据已经和Fiddler抓取到的发送数据一样  还是返回个非法图片呢 跪求大佬指点一下

[Visual Basic] 纯文本查看 复制代码

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

漁滒

看大佬最近几个帖子，都是用VBA写的，强！不考虑用其他语言吗？

约定的童话

图床用VBA上传之前也是一直失败，找不到原因，至今搁置了.....

颜师古都

漁滒 发表于 2022-7-18 23:13
看大佬最近几个帖子，都是用VBA写的，强！不考虑用其他语言吗？

只会VBA啊 难

颜师古都

约定的童话 发表于 2022-7-19 07:20
图床用VBA上传之前也是一直失败，找不到原因，至今搁置了.....

尝试了几个网站的图片上传 都失败了 也不懂在哪里失败了

知心

逐个删减headers试试，Content-Length不能设置固定值，这个是内容长度，根据内容的不同动态变化的

等到烟火也清凉

先VB6试试 VBA VB6差不多又小不同

漁滒

颜师古都 发表于 2022-7-19 08:11
只会VBA啊 难

大佬做的什么业务的，又有验证码又有图床的

颜师古都

漁滒 发表于 2022-7-19 09:15
大佬做的什么业务的，又有验证码又有图床的

哈哈哈 我做工地的 我想学一下图片上传 这几天一直卡在这里 差不多要放弃了

颜师古都

知心 发表于 2022-7-19 08:31
逐个删减headers试试，Content-Length不能设置固定值，这个是内容长度，根据内容的不同动态变化的

我研究研究 谢谢指导