以下是源码，请命名为.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:///baidu?word="&word&"&pn="&cint(pn)+intbpn*10
//response.write(strurl&"<br>")

oXMLHTTP.open"GET",strurl,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
thei=0
fori=1to10
thei=st+i
//response.write(thei)
Pos=Instr(BodyText(thei),"<td")
pos1=Instr(BodyText(thei),"</td>")
Body=mid(BodyText(thei),pos,len(BodyText(thei))-pos)

Pos3=Instr(Body,url)
ifPos3>0then
pp=pn+i
out=1
ExitFor
endif
next


ifout=1orpn=90then
exitdo
endif

pn=cint(pn)+10
loop
ifpp<>0then
response.write("<br><br>网站<b>'"&url&"'</b>在搜索关键词<b>'"&word&"'</b>时在百度中排名名次第<b>"&pp+intbpn*10&"</b>位")
else
response.write("<br><br>网站<b>'"&url&"'</b>在搜索关键词<b>'"&word&"'</b>时在百度中排名名次<fontcolor=red>未在"&intbpn*10+1&"名到"&intbpn*10+100&"内</font>")
endif


SetoXMLHTTP=Nothing
iferr.number<>0then
response.write"出错了，错误描述："&err.description&"<br>错误来源"&err.source
response.End()
endif

EndFunction

FunctionBytesToBstr(body,Cset)
dimobjstream
setobjstream=Server.CreateObject("adodb.stream")
objstream.Type=1
objstream.Mode=3
objstream.Open
objstream.Writebody
objstream.Position=0
objstream.Type=2
objstream.Charset=Cset
BytesToBstr=objstream.ReadText
objstream.Close
setobjstream=nothing
EndFunction
PublicFunctionHTMLEncode(fString)
IfNotIsNull(fString)Then
fString=replace(fString,">","&gt;")
fString=replace(fString,"<","&lt;")
fString=Replace(fString,CHR(32),"")'&nbsp;
fString=Replace(fString,CHR(9),"")'&nbsp;
fString=Replace(fString,CHR(34),"&quot;")
fString=Replace(fString,CHR(39),"&#39;")'单引号过滤
fString=Replace(fString,CHR(13),"")
fString=Replace(fString,CHR(10)&CHR(10),"</P><P>")
fString=Replace(fString,CHR(10),"<BR>")
HTMLEncode=fString
EndIf
EndFunction




%>
<title>关键字,网站在百度中排名查询</title>
<hr><hr><b>
关键字,网站在百度中排名查询:
<formname="form1"method="post"action="?action=1">
网址:
<inputtype="text"name="url"value="<%=url%>">
关键字:
<inputtype="text"name="word"value="<%=word%>">
查询范围:
<selectname="bpn">
<optionvalue="0"<%if(bpn="0")thenresponse.write("selected")endif%>>1-100</option>
<optionvalue="10"<%if(bpn="10")thenresponse.write("selected")endif%>>101-200</option>
<optionvalue="20"<%if(bpn="20")thenresponse.write("selected")endif%>>201-300</option>
<optionvalue="30"<%if(bpn="30")thenresponse.write("selected")endif%>>301-400</option>
<optionvalue="40"<%if(bpn="40")thenresponse.write("selected")endif%>>401-500</option>
<optionvalue="50"<%if(bpn="50")thenresponse.write("selected")endif%>>501-600</option>
<optionvalue="60"<%if(bpn="60")thenresponse.write("selected")endif%>>601-700</option>
<optionvalue="70"<%if(bpn="70")thenresponse.write("selected")endif%>>701-800</option>
<optionvalue="80"<%if(bpn="80")thenresponse.write("selected")endif%>>801-900</option>
<optionvalue="90"<%if(bpn="90")thenresponse.write("selected")endif%>>901-1000</option>
</select>

<inputtype="submit"name="Submit"value="提交">
</form>