Google rankings can query the ASP source code _ Application techniques

The following is the source code, please name it. ASP files.

Copy Code code as follows:

<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& "keywords in google search rankings, top 10 sites!</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& "&AMP;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>
Next

Set oxmlhttp = Nothing
If Err.number<>0 Then
Response.Write "Error, Description:" &err.description & "<br> error source" & 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 = Then
Exit Do
End If

Start = CInt (start) +10
Loop
If pp <> 0 Then
Response.Write ("<br><br> website <b> '" &url& "' </b> in search keyword <b> '" "&word&" " </b> in Google ranked rank <b> "&pp&" </b> bit)
Else
Response.Write ("<br><br> website <b> '" &url& "' </b> in search keyword <b> '" "&word&" " </b> in Google ranked <font color=red> not in the top 100 </font> ")
End If


Set oxmlhttp = Nothing
If Err.number<>0 Then
Response.Write "Error, Description:" &err.description & "<br> error source" & 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), "'") ' single quote filter
fstring = Replace (fstring, CHR (13), "")
fstring = Replace (fstring, CHR (a) & CHR (a), "</P><P>")
fstring = Replace (fstring, CHR (), "<BR>")
HTMLEncode = fstring
End If
End Function




%>
<title> keywords, web site in Google rankings query </title>
Keywords, the site in Google ranking query:
<form name= "Form1" method= "Post" action= "Action=1" >
Url:
<input type= "text" name= "url" >
Key words
<input type= "text" name= "word" >
<input type= "Submit" name= "Submission" value= "submitted" >
</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+ "&AMP;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.parentno De;if (f) p = F.id;t = H.id;} if (t==a | | p==a | | r==a) return True;document.getelementbyid (a). href + = "&AMP;CT=BG"; window.open ( document.getElementById (a). href, ' NW '}}
-->
</script>