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

ASP
asp生成三维饼图的函数
ASP下的简洁的多重查询的方法与函数 真不错
发一个ASP的ADODB类代码
A利用ASP小偷和Google实现在线翻译功能的代码
ASP类型网站结合动网论坛会员的方法
Asp下实现多表单域无组件文件上传的实例
asp制作中常用到的函数库集合
易心asp分页类 v1.0
asp中xmlhttp组件发包
检测是否为数字类型的asp代码
可以获得文件的文件名的asp函数
用asp实现访问远程计算机上MDB access数据库文件的方法
用ASP实现写IIS日志的代码
asp在IE浏览器中下载服务端上的各类文件的实现方法
asp汉字中文图片验证码的实现代码
asp WAP获取手机终端信息的一段代码
asp取得数组中的最大值的方法
用asp实现的截取指定格式字符串的代码
asp jmail发邮件 详细解析
ASP编程中连接数据库和数据库操作的常用代码

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


出处:互联网   整理: 软晨网(RuanChen.com)   发布: 2009-09-13   浏览: 131 ::
收藏到网摘: 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>