可以查询百度排名的asp源码放送了

　　以下是源码，请命名为.asp文件

复制代码 代码如下:
<%
bpn=request(bpn)
if(bpn=)then
bpn=0
endif
intbpn=cint(bpn)

ifrequest(action)=1then
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.openGET,
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
DimoXMLHTTPAsObject
DimoCategoriesAsObject
DimBodyText
DimPos,Pos1
SetoXMLHTTP=CreateObject(Microsoft.XMLHTTP)

out=0
pn=0
pp=0
dowhile(true)

strurl=
//response.write(strurl&<br>)

oXMLHTTP.openGET,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,>,>)
fString=replace(fString,<,<)
fString=Replace(fString,CHR(32),)
fString=Replace(fString,CHR(9),)
fString=Replace(fString,CHR(34),")
fString=Replace(fString,CHR(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=form1method=postaction=?action=1>
网址:
<inputtype=textname=urlvalue=<%=url%>>
关键字:
<inputtype=textname=wordvalue=<%=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=submitname=Submitvalue=提交>
</form>