可以查询百度排名的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 

内容版权声明:除非注明,否则皆为本站原创文章。

转载注明出处:http://www.heiqu.com/3203.html