|
|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
在用urldownloadtofile下载百度图片时有时会卡住，明明文件不大，有方法把下载时间较长的跳过吗？或者有没有其他方法，实在等的太慢了
#If VBA7 Then '64位
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal IpfnCB As Long) As Long
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal IpfnCB As Long) As Long
#End If
Sub DownLoadFile1()
Dim PageNum
Dim sSource As String
Dim sLocal As String
PageNum = 0
j = 1
For k = 1 To 2
sSource = "https://image.baidu.com/search/acjson?tn=resultjson_com&logid=11400304292847218692&ipn=rj&ct=201326592&is=&fp=result&fr=&word=%E7%BE%8E%E5%A5%B3&cg=girl&queryWord=%E7%BE%8E%E5%A5%B3&cl=2&lm=-1&ie=utf-8&oe=utf-8&adpicid=&st=-1&z=0&ic=0&hd=0&latest=0©right=0&s=&se=&tab=&width=&height=&face=0&istype=2&qc=&nc=1&expermode=&nojc=&isAsync=&pn=" & PageNum & "&rn=30&gsm=1e&1681179430816="
sLocal = "C:\Users\16118\Desktop\百度图片\" '下载保存路径
With CreateObject("Msxml2.XMLHTTP")
.Open "GET", sSource
.Send
Do Until .ReadyState = 4
DoEvents
Loop
s = Split(.responseText, """")
For i = 2 To UBound(s)
If s(i) Like "ippr*" And s(i - 2) = "objURL" Then
Debug.Print decode(s(i) & "")
URLDownloadToFile 0, decode(s(i) & ""), sLocal & j & ".jpg", 0, 0
j = j + 1
End If
Next
Erase s
End With
PageNum = PageNum + 30
Next
MsgBox "已完成！"
End Sub
Function decodes(s As String) As String
Dim str As String
Dim bef_chr()
Dim aft_chr()
bef_chr() = Array("w", "k", "v", "1", "j", "u", "2", "i", "t", "3", "h", "s", "4", "g", "5", "r", "q", "6", "f", "p", "7", "e", "o", "8", "d", "n", "9", "c", "m", "0", "b", "1", "a", "-")
aft_chr() = Array("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "1", "2", "3", "4", "5", "6", "7", "8", "9", "0", "-")
str = ""
s = Replace(s, "_z2C$q", ":") '"_z2C$q", "_z&e3B", "AzdH3F"
s = Replace(s, "_z&e3B", ".") '":", ".", "/"
s = Replace(s, "AzdH3F", "/")
flag = True
For i = 1 To Len(s)
For j = 0 To UBound(bef_chr)
If Mid(s, i, 1) = bef_chr(j) Then
str = str & aft_chr(j)
flag = False
Exit For
Else
flag = True
End If
Next j
If flag Then
str = str & Mid(s, i, 1)
End If
flag = True
Next i
decodes = str
'decode = Replace(str, " ", "")
'加密{w:"a",k:"b",v:"c",1:"d",j:"e",u:"f",2:"g",i:"h",t:"i",3:"j",h:"k",s:"l",4:"m",g:"n",5:"o",r:"p",q:"q",6:"r",f:"s",p:"t",7:"u",e:"v",o:"w",8:"1",d:"2",n:"3",9:"4",c:"5",m:"6",0:"7",b:"8",l:"9",a:"0",_z2C$q:":","_z&e3B":".",AzdH3F:"/"}
End Function
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2023-4-11 17:11
楼主
