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

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

复制代码代码如下:
<%
bpn = request（"bpn"）
if（bpn = ""） then
bpn = "0"
end if
intbpn = cint（bpn）

if request（"action"） = "1" then
word = request（"word"）
url = request（"url"）
if word <> "" then
  getCategories（）
  if url <> "" then
   getCategories2（）
  end if
end if
end if

Function getCategories（）

response.write（"<b>""&word&"" 关键词在百度搜索排名中,前10位网站！</b><br>"）

on error resume next
Dim oXMLHTTP
Dim oCategories
Dim BodyText
Dim Pos,Pos1
Set oXMLHTTP = 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
for i = 1 to 10
   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

Set oXMLHTTP = Nothing
if err.number<>0 then
response.write "出错了，错误描述："&err.description & "<br>错误来源"& err.source
response.End（）
end if
End Function

Function getCategories2（）
on error resume next
Dim oXMLHTTP " As Object
Dim oCategories " As Object
Dim BodyText
Dim Pos,Pos1
Set oXMLHTTP = CreateObject（"Microsoft.XMLHTTP"）

out = 0
pn = 0
pp = 0
do while（true）

strurl="http://www.baidu.com/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
for i = 1 to 10
   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）
  if Pos3 > 0 then
   pp = pn + i
   out = 1
   Exit For
  end if
next

if out = 1 or pn = 90 then
  exit do
end if

pn = cint（pn）+10
loop
if pp <> 0 then
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> 时在百度中排名名次 <font color=red>未在"&intbpn*10+1&"名到"&intbpn*10+100&"内</font>"）
end if

Set oXMLHTTP = Nothing
if err.number<>0 then
response.write "出错了，错误描述："&err.description & "<br>错误来源"& err.source
response.End（）
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
Public Function HTMLEncode（fString）
  If Not IsNull（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
  End If
End Function

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

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