抓取baidu收录页面有些问题。请高人指点一下。程序为ASP - Web 开发 / 其他
抓取baidu收录页面有些问题。请高人指点一下。程序为ASP
就baidu的抓取结果总是0
<%
sl=request.QueryString("sl")
sw=request.QueryString("url")
sw=replace(sw,"http://","")
if sl="baidu" then
'百度收录
BaiduCldeContent = getHTTPPage("http://www.baidu.com/s?bs=site:"&sw&"&cl=3") '要提取页面的url地址
StartBaidu="百度一下，找到相关网页"
OverBaidu="，用时"
mmm=GetBody(BaiduCldeContent,StartBaidu,OverBaidu,IncluL,IncluR)
mmm=replace(mmm,"相关结果","")
mmm=replace(mmm,"无","0")
mmm=replace(mmm,"个","")
%>
document.getElementById("seo_baidu_0").value = "<%=mmm%>";document.getElementById("flag_baidu_0").innerHTML = "<img src='images/check_right.gif'> <a
href='http://www.baidu.com/s?wd=site:<%=sw%>' target='_blank'>查看详细</a>";
<%
elseif sl="google" then
'谷歌收录
googleCldeContent = getHTTPPage("http://www.google.com.hk/search?hl=zh-CN&q=site%3A"&sw&"&meta=&aq=1") '要提取页面的url地址
Startgoogle="找到约 "
Overgoogle=" 条结果"
mmm=GetBody(googleCldeContent,Startgoogle,Overgoogle,IncluL,IncluR)
%>
document.getElementById("seo_google_0").value = "<%=mmm%>";document.getElementById("flag_google_0").innerHTML = "<img src='images/check_right.gif'> <a
href='http://www.google.com.hk/search?hl=zh-CN&q=site%3A<%=sw%>' target='_blank'>查看详细</a>";
<%
elseif sl="pr" then
PRCldeContent = getHTTPPage("http://www.xnbird.com/ranks/pr.php?website="&sw) '要提取页面的url地址
Startyahoo="images/pagerank"
Overyahoo=".gif"
mmm=GetBody(PRCldeContent,Startyahoo,Overyahoo,IncluL,IncluR)
mmm=replace(mmm,chr(10),"")
%>
document.getElementById("seo_pr_0").value = "<%=mmm%>";document.getElementById("flag_pr_0").innerHTML = "<img src='images/check_right.gif'> <a href='ranks/pr.php?website=<%
=sw%>' target='_blank'>查看详细</a>";
<%
elseif sl="kz" then
'PRCldeContent = getHTTPPage("http://i.linkhelper.cn/getbaiducachetime.asp?queryurl=http://www.xnbird.com&i=0") '要提取页面的url地址
PRCldeContent = getHTTPPage("http://www.baidu.com/s?wd=http://"&sw&"") '要提取页面的url地址
Startyahoo="</b>/ "
Overyahoo=" </span> - <a "
mmm=GetBody(PRCldeContent,Startyahoo,Overyahoo,IncluL,IncluR)
%>
document.getElementById("seo_kz_0").value = "<%=mmm%>";document.getElementById("flag_kz_0").innerHTML = "<img src='images/check_right.gif'>";
<%
elseif sl="alexa" then
alexaCldeContent = getHTTPPage("http://data.alexa.com/data/?cli=10&dat=snba&ver=7.0&url="&sw) '要提取页面的url地址
Startsogou=""" TEXT="""
Oversogou="""/>"
mmm=GetBody(alexaCldeContent,Startsogou,Oversogou,IncluL,IncluR)
%>
document.getElementById("seo_alexa_0").value = "<%=mmm%>";document.getElementById("flag_alexa_0").innerHTML = "<img src='images/check_right.gif'> <a href='ranks/pr.php?
website=<%=sw%>' target='_blank'>查看详细</a>";
<%
end if
Function GetInnerText(strHtml)
dim regEx
Set regEx = New RegExp
regEx.Pattern = "<\/?[^>]*>"
regEx.Global = True
regEx.IgnoreCase = True
GetInnerText = regEx.Replace(strHtml,"")
Set regEx = Nothing
End Function
'==================================================
'函数名：GetBody
'作 用：截取字符串
'参 数：ConStr ------将要截取的字符串
'参 数：StartStr ------开始字符串
'参 数：OverStr ------结束字符串
'参 数：IncluL ------是否包含StartStr
'参 数：IncluR ------是否包含OverStr
'==================================================
Function GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)
If ConStr="" or IsNull(ConStr)=True Or StartStr="" or IsNull(StartStr)=True Or OverStr="" or IsNull(OverStr)=True Then
GetBody="0"
Exit Function
End If
Dim ConStrTemp
Dim Start,Over
ConStrTemp=Lcase(ConStr)
StartStr=Lcase(StartStr)
OverStr=Lcase(OverStr)
Start = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)
If Start<=0 then
GetBody="0"
Exit Function
Else
If IncluL=False Then
Start=Start+LenB(StartStr)
End If
End If
Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)
If Over<=0 Or Over<=Start then
GetBody="无"
Exit Function
Else
If IncluR=True Then
Over=Over+LenB(OverStr)
End If
End If
GetBody=MidB(ConStr,Start,Over-Start)
End Function
%><%
Function GetHttpPage(HttpUrl)
If IsNull(HttpUrl)=True Then
response.Write("请输入网址！")
Exit Function
End If
On Error Resume Next
Dim Http
Set Http=server.createobject("MSX"&"ML2.XML"&"HTTP")
Http.open "GET",HttpUrl,False
Http.Send()
If Http.Readystate<>4 then
Set Http=Nothing
response.Write("该网页无法访问！")
Exit function
End if
if InStr(bytesToBSTR(Http.responseBody,"UTF-8"),"charset=")=0 then
GetHTTPPage=bytesToBSTR(Http.responseBody,"gb2312")
else
if left(split(bytesToBSTR(Http.responseBody,"UTF-8"),"charset=")(1),6)="gb2312" or left(split(bytesToBSTR(Http.responseBody,"UTF-8"),"charset=")
(1),6)="GB2312" then
GetHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
elseif left(split(bytesToBSTR(Http.responseBody,"UTF-8"),"charset=")(1),3)="gbk" or left(split(bytesToBSTR(Http.responseBody,"UTF-8"),"charset=")
(1),3)="GBK" then
GetHTTPPage=bytesToBSTR(Http.responseBody,"GBK")
elseif left(split(bytesToBSTR(Http.responseBody,"UTF-8"),"charset=")(1),5)="utf-8" or left(split(bytesToBSTR(Http.responseBody,"UTF-8"),"charset=")
(1),5)="UTF-8" then
GetHTTPPage=bytesToBSTR(Http.responseBody,"UTF-8")
else
GetHTTPPage=bytesToBSTR(Http.responseBody,"gb2312")
end if
end if
Set Http=Nothing
If Err.number<>0 then
Err.Clear
End If
End Function
Function BytesToBstr(Body,Cset)
Dim Objstream
Set Objstream = Server.CreateObject("adod"&"b.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
%>
[解决办法]
我来看看。。研究一下
