以下是源碼,請命名為.asp文件
複製代碼代碼如下:
<%
bpn=request("bpn")
if(bpn="")then
bpn="0"
endif
intbpn=cint(bpn)
ifrequest("action")="1"then
word=request("word")
url=request("url")
ifword<>""then
getCategories()
ifurl<>""then
getCategories2()
endif
endif
endif
FunctiongetCategories()
response.write("<b>'"&word&"'關鍵詞在百度搜索排名中,前10位網站!</b><br>")
onerrorresumenext
DimoXMLHTTP
DimoCategories
DimBodyText
DimPos,Pos1
SetoXMLHTTP=CreateObject("Microsoft.XMLHTTP")
oXMLHTTP.open"GET","http://www.baidu.com/baidu?word="&word,False
oXMLHTTP.send
BodyText=oXMLHTTP.responsebody
BodyText=BytesToBstr(BodyText,"gb2312")
Pos=Instr(BodyText,"<body")
pos1=Instr(BodyText,"</body>")
BodyText=mid(BodyText,pos,pos1)
BodyText=split(BodyText,"<table")
st=5
fori=1to10
thei=st+i
Pos=Instr(BodyText(thei),"<td")
pos1=Instr(BodyText(thei),"</td>")
Body=mid(BodyText(thei),pos,len(BodyText(thei))-pos)
body1=split(body,"<br>")
title=body1(0)
theurl=body1(2)
theurl=replace(theurl,"上的更多結果","")
response.write("T:"&title)
response.write("<br>")
response.write("U:"&theurl)
response.write("<br><hr>")
next
SetoXMLHTTP=Nothing
iferr.number<>0then
response.write"出錯了,錯誤描述:"&err.description&"<br>錯誤來源"&err.source
response.End()
endif
EndFunction
FunctiongetCategories2()
onerrorresumenext
DimoXMLHTTP'AsObject
DimoCategories'AsObject
DimBodyText
DimPos,Pos1
SetoXMLHTTP=CreateObject("Microsoft.XMLHTTP")