当前位置: 移动技术网 > IT编程>开发语言>Asp > 可以查询百度排名的asp源码放送了

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

2017年12月12日  | 移动技术网IT编程  | 我要评论
以下是源码,请命名为.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> 

如对本文有疑问, 点击进行留言回复!!

相关文章:

验证码:
移动技术网