ZBLOG模板读取器»

«新浪博客内容采集器

    在当前网站中显示即时的百度、谷歌收录数对站长来说一定是非常有用的。以前还不会编程的时候曾经网上到处找这类的代码，可惜都不满意，后来静下心下理理思路，其实实现很简单。讲讲思路，高手飘过。还是得使用XMLHTTP这个方式读取“site:您的域名”在百度和谷歌中的搜索结果代码，再用split来截取收录数。这里不就提供预览地址了，想要的请复制以下代码，并注明来路。

    使用方法：<%="百度收录本站"&GetCodeInBaidu&"条记录 谷歌收录本站"&GetCodeInGoogle&"条记录"%>

<%
'
'Author 石头  piresion@qq.com
'获取百度google收录数程序
'
'=================================================
On Error Resume Next
Function getHTTPPage(url)
set http=Server.createobject("Microsoft.XMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then
exit function
end if
getHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
set http=nothing
If Err.number<>0 then
Response.Write "代码获取失败"
Err.Clear
End If
End Function

Function BytesToBstr(body,Cset)
dim objstream
set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function

Function GetCodeInBaidu()
   IF Application("Baidu_SL")<>"" Then
      GetCodeInBaidu=Application("Baidu_SL")
     Else
      Code=GetCodeInURL("Baidu")
      Start_Inf_Code="nowrap>百度一下，找到相关网页"
      End_Inf_Code="篇"
      IF Code="" Or InStr(Code,Start_Inf_Code)<1 Then
         GetCodeInBaidu="0"'没有找到
   Application("Baidu_SL")=0
    Else
      Final_A=GetKey(Code,Start_Inf_Code,End_Inf_Code)
      Application("Baidu_SL")=Replace(Final_A,"约","")
      GetCodeInBaidu=Application("Baidu_SL")
      End IF
   End IF    
End Function

Function GetCodeInGoogle()
   IF Application("Google_SL")<>"" Then
      GetCodeInGoogle=Application("Google_SL")
     Else
      Code=GetCodeInURL("Google")
      Start_Inf_Code="<b>"&request.ServerVariables("HTTP_HOST")&"</b>"
      End_Inf_Code="</b>"
      IF Code="" Or InStr(Code,Start_Inf_Code)<1 Then
         GetCodeInGoogle="0"
   Application("Google_SL")=0
       Else
      Final_A=GetKey(Code,Start_Inf_Code,End_Inf_Code)
      Application("Google_SL")=Replace(Replace(Replace(Final_A,"鑾峰緱绾?",""),"<b>","")," ","")
      GetCodeInGoogle=Application("Google_SL")
      End IF
   End IF    
End Function

Function GetCodeInURL(SearchE)
   s_CurrentUrl=request.ServerVariables("HTTP_HOST")
   Select Case SearchE
      Case "Baidu"
     s_SearchUrl="http://www.baidu.com/s?wd=site%3A"&s_CurrentUrl
      Case "Google"
     s_SearchUrl="http://www.google.cn/search?hl=zh-CN&newwindow=1&q=site%3A"&s_CurrentUrl&"&aq=f&oq="
   End Select 
   GetCodeInURL=getHTTPPage(s_SearchUrl)
End Function 

Function GetKey(HTML,Start,Last)'此方法引自http://blog.csdn.net/wvtjplh/archive/2009/02/20/3915828.aspx
   Filearray=Split(HTML,Start)
   Filearray2=Split(Filearray(1),Last)
   GetKey=Filearray2(0)
End Function
%>