可以查询百度排名的asp源码放送了
程序员文章站
2023-12-05 23:01:16
以下是源码,请命名为.asp文件 复制代码 代码如下:<% bpn = request("bpn") if(bpn&nbs...
以下是源码,请命名为.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>
复制代码 代码如下:
<%
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>
上一篇: 批量文件自动搜索替换插入器 Ver2.1
下一篇: 整理了常用的微博营销方法分享给大家