The following is the source code. Please name it the. ASP file.
Copy codeThe Code is 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 ranking, top 10 websites! </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>
Next
Set oXMLHTTP = Nothing
If err. number <> 0 then
Response. write "error, 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
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> website <B> '" & url & "' </B> Search for keywords <B> '" & word & "' </B> ranking <B> "& pp &" </B> in Google ")
Else
Response. write ("<br> website <B> '" & url & "' </B> Search for keywords <B> '" & word & "' </B> ranking in Google <font color = red> not in the top 100 </font> ")
End if
Set oXMLHTTP = Nothing
If err. number <> 0 then
Response. write "error, 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 quotation mark Filtering
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> keyword, ranking of websites in Google </title>
<Hr> <B>
Keyword:
<Form name = "form1" method = "post" action = "? Action = 1 ">
URL:
<Input type = "text" name = "url">
Keywords
<Input type = "text" name = "word">
<Input type = "submit" name = "Submit" value = "submit">
</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.tar get; 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 (). href + = "& ct = bg"; window. open (document. getElementById (). href, 'nw ')}}
// -->
</Script>