VBS 备份百度博客

VBS 备份百度博客

标签：杂谈

分类：网络技巧

sub denglu ()   '登陆百度，备份私有博客
'on error resume next
do
up = inputbox("请输入用户名和密码" & vbcrlf & "之间以分号 " & chr(34) & ";" & " 隔开",m1)
loop until trim(up) <> "" and len(trim(up)) > 8 and instr(up,";") <> 0
usps = split(trim(up),";")
         ie.visible = false
ie.navigate "http://passport.baidu.com/?login "
Do
Wscript.Sleep 200
Loop Until ie.ReadyState=4
ie.document.getElementById("username").value = usps(0)
ie.document.getElementById("password").value = usps(1)
tj = ie.document.getElementsBytagname("form")
tj.submit
Do
Wscript.Sleep 200
Loop Until ie.ReadyState=4
wscript.sleep 1000
end sub

function isregu(regu,s) '正则表达式判断地址是否合法
'on error resume next
set re = new regexp
re.pattern = regu
sre = re.test(s)
if sre = true then
isregu = true
else
isregu = false
end if
end function

sub bftxt(blogurl) '以TXT格式备份
'on error resume next

ie.visible = 1
ie.navigate blogurl
do until ie.readystate = 4 or ie.buzy
wscript.sleep 200
loop
wscript.sleep 250
text = ie.document.body.innertext
title = ie.document.title
set note = fso.createtextfile(path & "\" & title & ".txt")
note.write text
note.close
end sub

sub bfhtm(blogurl) '以HTML格式备份
'on error resume next
set xh = createobject("Microsoft.XMLHTTP")
xh.Open "GET",blogurl,0
xh.Send()
set ad = createobject("ADODB.Stream")
ad.mode = 3
ad.Type = 1
ad.Open()
ad.Write(xh.responseBody)
ad.savetofile path & "\" & now &".html"

'未完成

ad.SaveToFile path & "\",2
set xh = nothing
set ad = nothing
end sub

'on error resume next
set ws = createobject("wscript.shell")
set fso = createobject("scripting.filesystemobject")
path = ws.currentdirectory
if right(path,1) <> "/" then path = path & "\"
m1 = "VBS百度博客备份工具-by:xiaomingtt"
m2 = "单击"&chr(34)&"是"&chr(34)&"保存为"&chr(34)&"HTML文档"&chr(34)
m3 = "单击"&chr(34)&"否"&chr(34)&"保存为"&chr(34)&"TXT文档"&chr(34)
m4 = "单击"&chr(34)&"取消"&chr(34)&"退出程序"
do
add = inputbox("请输入百度博客地址" & vbcrlf & m4,m1,"http://hi.baidu.com/ ")
if add = "" or add = false then wscript.quit
add = trim(add)
loop until isregu("^http://hi\.baidu\.com/.+$",add) = true
txt = msgbox(m2 & vbcrlf & m3 & vbcrlf & m4,35,m1)
if txt = 2 then wscript.quit
a = msgbox("是否备份私有博客？" & vbcrlf & m4,3+32,m1)
if a = 2 then wscript.quit
fso.createfolder(path & "百度博客")
path = path & "百度博客\" & right(add,len(add) - instrrev(add,"/"))
fso.createfolder(path)
set ie = createobject("internetexplorer.application")
if a = 6 then
call denglu()
do until ie.document.location.href = "http://passport.baidu.com/center " and ie.readystate = 4
wscript.sleep 500
loop
end if
wscript.sleep 500

if right(add,1) <> "/" then add = add & "/"
url = add & "blog/index/0"
urll = url
do
url = urll
ie.navigate url
ie.visible = 1  

do until ie.readystate = 4
wscript.sleep 200
loop
wscript.sleep 500

urlnum = ie.document.links.length
for i = 0 to urlnum - 1
t = ie.document.links(i).innertext
w = ie.document.links(i).href
if t = "下一页" then urll = w
if isregu("^http://hi\.baidu\.com/.*/blog/item/[a-f0-9]{24}\.html$",w) = true and instr(t,"浏览") = 0 then
if txt = 7 then
     uw = uw & w & ","   
end if
if txt = 6 then
     call bfhtm(w)
end if
end if
next
uw = left(uw,len(uw) - 1)
ur = split(uw,",")
for wu = 0 to ubound(ur)
call bftxt(ur(wu))
next
loop until urll = url
msgbox "备份完毕!" & vbcrlf & "文件保存在：" & path,64,m1