可以查询google排名的asp源码

以下是源码，请命名为．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>