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