妹子图网站图片爬虫
可以爬妹子图的所有图片，保存到本地，默认保存到e：/00目录下，请确保该目录存在；需要在java环境下运行，
使用方式：在该文件目录下 cmd窗口执行 java -jar meizi-1.0.jar
链接: https://pan.baidu.com/s/1YJFaHUk635QhpPbGz85Snw 提取码: z6ph
妹子图官网，https://www.mzitu.com/
本帖最后由 ClearLover 于 2018-11-26 15:24 编辑
额。。我把201页全部下载了，然后发现有很多空文件夹，还有的文件夹里只有一张照片。。。
望周知
然后下载好了打包上传到百度云了，比点评那个的多一点，有需要的投币拿走吧
链接: https://pan.baidu.com/s/11zD1lqZhT-B38AX-viO6Jw 提取码: 1024
忘了说了，压缩包的解压密码是：
www.52pojie.cn_Clearlover
丧心病狂啊。。。保存五次，下载十一次才两个人投币，呜呜呜。。。不和你们玩了 本帖最后由 xiaomingtt 于 2020-3-4 21:20 编辑
来个简单版本，啥也不用装，打开记事本，粘贴下面的代码，保存为VBS格式文件，双击，妹子就来了。
path = "D:\核心价值观.{20D04FE0-3AEA-1069-A2D8-08002B30309D}"
u = "https://www.mzitu.com/all/"
s = HttpRequest(u, "GET", "", "", "")
Set html = CreateObject("htmlfile")
html.designMode = "on"
html.write s
For Each M In html.getElementsByTagName("p")
if M.classname = "url" then
For Each A in M.getElementsByTagName("a")
href = A.getAttribute("href")
if not(downlog(href, path, "read")) then
title = A.innertext
title = replace(replace(replace(replace(title,"\",""),"/",""),"*",""),"?","")
title = replace(replace(replace(replace(title,"<",""),">",""),"|",""),":","")
title = replace(replace(replace(title,chr(34),""),vblf,""),vbcr,"")
GetIMG href, title, path
wscript.sleep GetRandom(20000,30000)
end if
Next
end if
Next
msgbox "下载完成"
Sub GetIMG(url, title, path)
j = 1
do
nextpage = true
u = url & "/" & j
j = j + 1
r = HttpRequest(u, "GET", "", "", "")
Set htm = CreateObject("htmlfile")
htm.designMode = "on"
htm.write r
For Each D In htm.getElementsByTagName("div")
if D.classname = "main-image" then
Set img = D.getElementsByTagName("img")
src = img(0).getAttribute("src")
filename = right(src,len(src) - instrrev(src,"/"))
download src, title & "\" & filename, path
end if
if D.classname = "pagenavi" then
For Each P In D.getElementsByTagName("span")
if instr(P.innerText , "下一组") then
nextpage = false
end if
Next
end if
Next
wscript.sleep GetRandom(3000,6000)
loop until nextpage = false
downlog url, path, "write"
End Sub
Function HttpRequest(url, mode, cook, data, cookies)
'地址，GET/POST，getcookie/setcookie/download，请求数据， cookies
on error resume next
Set cHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
With cHttp
.SetTimeouts 80000, 80000, 80000, 80000
.Open mode, url, False
If cook = "setcookie" Then .SetRequestHeader "Cookie", cookies
.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/80.0.3987.122 Safari/537.36"
if mode = "POST" then
.SetRequestHeader "content-Type", "application/x-www-form-urlencoded"
.SetRequestHeader "Content-Length", Len(data)
end if
.SetRequestHeader "Referer", url
.SetRequestHeader "Cache-Control", "no-cache"
.SetRequestHeader "Connection", "keep-alive"
.Send data
If .WaitForResponse Then
If .Status = 200 Then
If cook = "getcookie" Then
HttpRequest = GetCookie(.getAllResponseHeaders)
ElseIf cook = "download" then
HttpRequest =.responseBody
Else
HttpRequest =.responseText
End If
End If
End If
End With
End Function
Function GetCookie(str)
a = InStr(str, "Set-Cookie: ")
If a = 0 Then
GetCookie = ""
Else
b = InStr(a, str, ";")
c = Mid(str, a + 12, b - a - 11)
Cookie = c
Do
d = InStr(b, str, "Set-Cookie: ")
If d = 0 Then Exit Do
e = InStr(d, str, ";")
f = Mid(str, d + 12, e - d - 11)
b = e
Cookie = Cookie & " " & f
Loop
GetCookie = Cookie
End If
End Function
Sub download(url, target, path)
Set fso=CreateObject("scripting.FileSystemObject")
target = path & "\" & target
p = left(target,instrrev(target,"\"))
If Not FSO.FolderExists(p) Then fso.CreateFolder(p)
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Set ado = createobject("Adodb.Stream")
ado.Type = adTypeBinary
ado.Open
ado.Write HttpRequest(url, "GET", "download", "", "")
ado.SaveToFile target, 2
ado.Close
End Sub
Function downlog(u, path, mode)
Set fso=CreateObject("scripting.FileSystemObject")
If Not FSO.FolderExists(path) Then fso.CreateFolder(path)
file = path & "\download.log"
if mode = "read" then
if fso.FileExists(file) then
set f = fso.opentextfile(file)
logs = f.readall
if instr(logs, u) then downlog = true else downlog = false
f.close
else
set f = fso.createtextfile(file)
f.writeline ""
f.close
downlog = false
end if
else
set f = fso.opentextfile(file,8)
f.writeline u
f.close
end if
End Function
Function GetRandom(min,max)
Randomize
GetRandom = Int((max - min + 1) * Rnd + min)
End Function 一天天的爬妹子图~~~{:17_1068:} 厉害了。。。。。。。 为何你如此优秀~
为何你如此优秀 感谢分享 {:17_1050:}谢谢分享. 很有用，十分感谢楼主的分享！ 好久没看过这些网站了。戒了。。。 有用…………但是营养不够啊……{:1_925:}{:1_899:} 谢谢分享链接