VBA网抓图片上传失败

颜师古都 发表于 2022-7-18 20:40

本帖最后由颜师古都于 2022-7-24 08:22 编辑

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

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

漁滒发表于 2022-7-18 23:13

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

约定的童话 发表于 2022-7-19 07:20

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

颜师古都 发表于 2022-7-19 08:11

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

只会VBA啊难

颜师古都 发表于 2022-7-19 08:13

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

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

知心发表于 2022-7-19 08:31

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

等到烟火也清凉 发表于 2022-7-19 09:11

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

漁滒发表于 2022-7-19 09:15

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

大佬做的什么业务的，又有验证码又有图床的{:17_1080:}

颜师古都 发表于 2022-7-19 09:18

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

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

颜师古都 发表于 2022-7-19 09:18

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

我研究研究谢谢指导

页: [1] 2 3

吾爱破解 - 52pojie.cn's Archiver

VBA网抓图片上传失败