可以查询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>