当前位置: 首页 > 图文教程 > 网络编程 > ASP > 可以查询google排名的asp源码

ASP
asp实现取得数组中的最大值的代码
asp 将日期格式化为需要的格式
asp 下产生任意位数随机密码的代码
asp下返回以千分位显示数字格式化的数值
asp重定向页面的方法总结
asp下去除数组中重复的项的方法
asp下实现 重新排序数字数组的代码
asp 验证输入网址是否有效并可以访问 与正则验证输入网址
asp验证Ip格式的函数
asp实现生成由数字,大写字母,小写字母指定位数的随机数
asp 格式化sql中的like字符串
asp 实现显示所有的服务器变量值的函数
asp 取得用户真实IP,对代理地址仍然有效的函数
asp 通用数据库连接过程函数
asp 字符串截取函数
asp下实现格式化文件大小以MB显示的函数
asp 下用正则表达式检测邮箱格式的函数
asp 实现检测字符串是否为纯字母和数字组合的函数
asp代码实现检测组件是否安装的函数
asp通过JMAIL实现通用发送函数

ASP 中的 可以查询google排名的asp源码


出处:互联网   整理: 软晨网(RuanChen.com)   发布: 2009-09-13   浏览: 120 ::
收藏到网摘: n/a

以下是源码,请命名为.ASP文件.
复制代码 代码如下:

<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<%
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&"' 关键词在Google搜索排名中,前10位网站!</b><br>")
on error resume next
Dim oXMLHTTP
Dim oCategories
Dim BodyText
Dim Pos,Pos1
Set oXMLHTTP = CreateObject("Microsoft.XMLHTTP")
http = "http://www.google.com/search?q="&word&"&hl=zh-CN"
oXMLHTTP.open "GET",http,False
oXMLHTTP.send
BodyText=oXMLHTTP.responsebody
BodyText=BytesToBstr(BodyText,"UTF-8")
Pos=Instr(BodyText,"<body")
pos1=Instr(BodyText,"</body>")
BodyText=mid(BodyText,pos,pos1)
Pos = Instr(BodyText,"<div>")
BodyText = Mid(BodyText,Pos)
pos1=Instr(BodyText,"</div>")
BodyText=mid(BodyText,1,pos1)
'response.write ("::::"&BodyText&"::::")
BodyText=split(BodyText,"<p class=g>")
for i = 1 to 10
Pos=Instr(BodyText(i),"</a>")
thet = Mid(BodyText(i),1,Pos+3)
Pos = Instr(BodyText(i),"<span dir=ltr>")
theu = Mid(BodyText(i),Pos)
pos1=Instr(theu,"</span>")
theu=mid(theu,1,pos1-1)
response.write("T:"&thet&"<br>")
response.write("U:"&theU&"<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
start = 0
pp = 0
do while(true)
strurl="http://www.google.com/search?q="&word&"&hl=zh-CN&start="&start
'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)

Pos = Instr(BodyText,"<div>")
BodyText = Mid(BodyText,Pos)
pos1=Instr(BodyText,"</div>")
BodyText=mid(BodyText,1,pos1)
'response.write ("::::"&BodyText&"::::")
BodyText=split(BodyText,"<p class=g>")
for i = 1 to 10
Pos = Instr(BodyText(i),"<span dir=ltr>")
theu = Mid(BodyText(i),Pos)
pos1=Instr(theu,"</span>")
theu=mid(theu,1,pos1-1)
'response.write(theu)
Pos3=Instr(theu,url)
if Pos3 > 0 then
pp = start + i
out = 1
Exit For
end if
next
if out = 1 or start = 90 then
exit do
end if
start = cint(start)+10
loop
if pp <> 0 then
response.write("<br><br>网站 <b>'"&url&"'</b> 在搜索关键词 <b>'"&word&"'</b> 时在Google中排名名次 第<b> "&pp&" </b>位 ")
else
response.write("<br><br>网站 <b>'"&url&"'</b> 在搜索关键词 <b>'"&word&"'</b> 时在Google中排名名次 <font color=red>未在前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>关键字,网站在Google中排名查询</title>
<hr><hr><b>
关键字,网站在Google中排名查询:
<form name="form1" method="post" action="?action=1">
网址:
<input type="text" name="url">
关键字
<input type="text" name="word">
<input type="submit" name="Submit" value="提交">
</form>
<b>
<script>
<!--
function ss(w,id){window.status=w;return true;}
function cs(){window.status='';}
function clk(url,ct,cd,sg){if(document.images){var u="";if (url) u="&url="+escape(url).replace(/\+/g,"%2B");new Image().src="/url?sa=T&ct="+escape(ct)+"&cd="+escape(cd)+u+"&ei=r9vyQ9ypE5GsoQKL4KDyCg"+sg;}return true;}
function ga(o,e) {if (document.getElementById) {var a = o.id.substring(1); var p = "", r = "", t, f, h;var g = e.target;if (g) { t = g.id;f = g.parentNode;if (f) {p = f.id;h = f.parentNode;if (h)r = h.id;}} else {h = e.srcElement;f = h.parentNode;if (f)p = f.id;t = h.id;}if (t==a || p==a || r==a)return true;document.getElementById(a).href += "&ct=bg";window.open(document.getElementById(a).href,'nw')}}
//-->
</script>