百度博客目录提取工具（HTM版）

BY Jmdcw

百度博客也试行了好长一段时间了，但直到现在，博客目录功能还是没有推出。虽然我为了解决这个问题，也建了个百度互联，但响应的人还是很少，可能是因为免费空间不稳定的原因，也可能是难登大雅之堂。

在冬眠之前，我曾写了一段 HTM版的目录提取代码，但一直没有放上来，下面就把代码贴出来。

代码如下：
<html><head> <title>HTML版目录提取工具（寂寞的刺猬）</title></head> <style type='text/css'> body{font-size: 10pt;} a{color: #000000;text-decoration : none;font-size: 10pt;} a:hover {color: red;text-decoration : underline;} td{color: #000000;text-decoration : none;font-size: 10pt;} </style>


<SCRIPT LANGUAGE="JavaScript">
<!--
function chkacc(){
j=document.getElementById("startnum").value;
v=document.getElementById("endnum").value;
w=document.getElementById("host").value;
g1=document.getElementById("checkMulu").checked;
g2=document.getElementById("TexMulu").value;
g3=document.getElementById("checkHtm").checked;
g4=document.getElementById("checkDate").checked;
g5=document.getElementById("checkLei").checked;
jmdcw=j + "|" + v + "|" + w + "|" + g1+ "|" + g2 + "|" + g3 + "|" + g4 + "|" + g5;
dq(jmdcw);
}
//-->
</SCRIPT>
<Script language=VBScript>
dim datec,leic,htmc,username
dim IDnum
Function bytes2BSTR(vIn) 'utf8转换函数
strReturn = ""
For i = 1 To LenB(vIn)
   ThisCharCode = AscB(MidB(vIn,i,1))
   If ThisCharCode < &H80 Then
     strReturn = strReturn & Chr(ThisCharCode)
   Else
     NextCharCode = AscB(MidB(vIn,i+1,1))
     strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
     i = i + 1
   End If
next
bytes2BSTR = jmtiqu(strReturn)
End Function
Function dq(start)'远程抓取函数
dim XmlHttp
zifu=split(start,"|")
datec=zifu(6)
leic=zifu(7)
htmc=zifu(5)
username=zifu(2)
If zifu(3)="true" then
FileUrl1 = "http://hi.baidu.com/" & URLEncoding(username) & "/blog/category/" & zifu(4) & "/index/"
else
FileUrl1 = "http://hi.baidu.com/" & URLEncoding(username) & "/blog/index/"
end if
if datec="true" then
BiaoTouD="<td>时    间</td>"
else
BiaoTouD=""
end if
if leic="true" then
BiaoTouL="<td>类   别</td>"
else
BiaoTouL=""
end if
sminfo.innerHTML = "<h4 align=center>" & zifu(2) & "的博客目录</h4><hr><div align='center'><table border=1><tr align=center><td>ID</td><td>文    章    目    录</td>" & BiaoTouD & BiaoTouL & "</tr>" & vbCrLf
IDnum=1
for k=int(zifu(0)) to int(zifu(1))
url=FileUrl1 &   k
set XmlHttp = CreateObject("Microsoft.XMLHTTP")
XmlHttp.Open "GET",url, false
XmlHttp.setRequestHeader "Content-Type","text/XML"
XmlHttp.Send
dq = bytes2BSTR(XmlHttp.responseBody)
next
sminfo.innerHTML =sminfo.innerHTML + "</table></div><br><p><hr><center><A href='http://hi.baidu.com/jmdcw'   target=_blank> JMDCW </a>制作-- 2007.06 </center></body></html>"
End Function
Function JmTiQu(BaiHtml)   '提取相关内容，JMDCW编写
Dim BaiDu
UrlStart = "<div class=" & Chr(34) & "tit" & Chr(34) & "><a href=" & Chr(34) & "/"
Const UrlEnd = "/"
NameStart = Chr(34) & " target=" & Chr(34) & "_blank" & Chr(34) & ">"
Const NameEnd = "</a></div>"
DataStart = "<div class=" & Chr(34) & "date" & Chr(34) & ">"
LeiStart = Chr(34) & ">类别："
ChaXu1 = UrlStart & URLEncoding(UserName) & UrlEnd
BaiDu = ""
Startme = 1    '定义首先为1位
   Do While Startme <> 0
Where1 = InStr(Startme, BaiHtml, ChaXu1)   '得到HTML的头部
Startme = Where1
If Startme = 0 Then Exit Do
Where2 = InStr(Startme, BaiHtml, NameStart) '得到HTLM的尾部
Startme = Where2
If Startme = 0 Then Exit Do
Where3 = InStr(Startme, BaiHtml, NameEnd)   '得到文章的尾部
Startme = Where3
If Startme = 0 Then Exit Do
Where4 = InStr(Startme, BaiHtml, DataStart)    '得到日期的头部
Startme = Where4
If Startme = 0 Then Exit Do
Where5 = InStr(Startme, BaiHtml, "</div>")   '得到日期的尾部
Startme = Where5
If Startme = 0 Then Exit Do
Where6 = InStr(Startme, BaiHtml, LeiStart)    '得到类别的头部
Startme = Where6
If Startme = 0 Then Exit Do
Where7 = InStr(Startme, BaiHtml, "</a>")   ' 得到类别的尾部
Startme = Where7
    If Where7 <> 0 Then
   'BaiHtmStr = Mid(BaiHtml, Where1 + Len(ChaXu1), (Where2 - Where1 - Len(ChaXu1)))   'html
   'BaiHtmStr = "http://hi.baidu.com/" & URLEncoding(UserName) & "/" & BaiHtmStr
   BaiFileStr = Mid(BaiHtml, Where2 + Len(NameStart), (Where3 - Where2 - Len(NameStart))) '文章
                 BaiDu = BaiDu & "<tr><td>" & IDnum & "</td>"
if htmc="true" then
BaiHtmStr = Mid(BaiHtml, Where1 + Len(ChaXu1), (Where2 - Where1 - Len(ChaXu1)))   'html
   BaiHtmStr = "http://hi.baidu.com/" & URLEncoding(UserName) & "/" & BaiHtmStr
BaiDu = BaiDu & "<td><a href='" & BaiHtmStr & "' target='_blank'>" & BaiFileStr & "</a></td>"
else
                 BaiDu = BaiDu & "<td>" & BaiFileStr & "</td>"
end if
                ' BaiDu = BaiDu & "<tr><td><a href='" & BaiHtmStr & "' target='_blank'>" & BaiFileStr & "</a></td>"
if datec="true" then
BaiDate = Mid(BaiHtml, Where4 + Len(DataStart), (Where5 - Where4 - Len(DataStart))) '日期
   BaiDate = Left(BaiDate, 11) & " " & Right(BaiDate, 5)
   BaiDu = BaiDu & "<td>" & BaiDate & "</td>"
end if
if leic="true" then
BaiLei = Mid(BaiHtml, Where6 + Len(LeiStart), (Where7 - Where6 - Len(LeiStart))) '类别
BaiDu = BaiDu & "<td>" & BaiLei & "</td>"
end if
                 BaiDu = BaiDu & "</tr>"
IDnum=IDnum+1
    End If
   Loop
sminfo.innerHTML = sminfo.innerHTML + BaiDu
End Function
Function URLEncoding(vstrin)   '转换汉字为十六进制字符 ，来源于网络
StrReturn = ""
Dim i
   For i = 1 To Len(vstrin)
ThisChr = Mid(vstrin, i, 1)
   If Abs(Asc(ThisChr)) < &HFF Then
    StrReturn = StrReturn & ThisChr
   Else
    InnerCode = Asc(ThisChr)
    If InnerCode < 0 Then
     InnerCode = InnerCode + &H10000
    End If
    Hight1 = (InnerCode And &HFF00) \ &HFF
    Low1 = InnerCode And &HFF
    StrReturn = StrReturn & "%" & Hex(Hight1) & "%" & Hex(Low1)
   End If
   Next
URLEncoding = StrReturn
End Function
</script>
<body>
<div align="center"><font color=red>HTML版目录提取工具</font><br>
<FORM METHOD=POST ACTION="" name="frm2">
开始页次：<input type="text" name="startnum" size=3 id="startnum">   结束页次<input type="text" name="endnum" size=3 id="endnum"><br>
用户的域名： <input type="text" name="host" id="host"><br>
高级：<input type="checkbox" name="checkMulu" id="checkMulu">按分类提取   <input type="text" name="TexMulu" size=12 value="默认分类" id="TexMulu"><br>
生成目录选项 <input type="checkbox" name="checkHtm" id="checkHtm" checked>链接 
<input type="checkbox" name="checkDate" id="checkDate" checked>时间 
<input type="checkbox" name="checkLei" id="checkLei" checked>分类 <br>
       <INPUT TYPE="button" value=" 提   取 " name="btnchk" onclick="chkacc();">
</FORM></div>
<div id="sminfo"></div>
</body>

</html>
使用方法：

将以上代码存到记事本中，然后将扩展名txt改为htm即可。双击此htm文件，打开的页面如图1：

然后在其中要提取的页次，注：在百度空间中，0表示第一页，1表示第二页，依次类推。比如我要提取我空间中的目录，从第一页到第第三页，就在开始页次中输入0，结束页次中输入2，在用户域名中输入：jmdcw。然后点提取，就得到这三页中的目录了。如图2：

只要将显示出的目录复制到博客之中，就能方便来客的浏览了。当然，你还可以按分类提取，或是选择所要显示的类型。有愿意用的朋友欢迎使用。如果转载的话，请保留文章的完整性，谢谢。

一点一滴，随手记之。

鬼仔's Blog

发表评论

分类

最新日志

最新评论

鬼仔's Blog