ASP query search engine keyword ranking work energy code

Baidu search engine rankings to check the source code.

Save the following as an ASP file and run a view with the following code:

<%
BPN = Request ("BPN")
if (BPN = "") Then
BPN = "0"
End If
INTBPN = CInt (BPN)
If Request ("action") = "1" Then
Word = Request ("word")
url = Request ("url")
If Url= "" Then
Url= "Alixixi.com"
End If
If word= "" Then
Word= "Arisisi"
End If

GetCategories ()
GetCategories2 ()
End If
Function getcategories ()
Response.Write ("<b>" &word& "' keywords in Baidu 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")
Oxmlhttp.open "Get", "http://www.baidu.com/baidu?word=" &word,false
Oxmlhttp.send
Bodytext=oxmlhttp.responsebody
Bodytext=bytestobstr (BodyText, "gb2312")
Pos=instr (BodyText, "<body")
Pos1=instr (BodyText, "</body>")
Bodytext=mid (BODYTEXT,POS,POS1)
Bodytext=split (BodyText, "<table")
St = 5
For i = 1 to 10
Thei = st + I
Pos=instr (BodyText (thei), "&LT;TD")
Pos1=instr (BodyText (thei), "</td>")
Body=mid (BodyText (thei), Pos,len (BodyText (thei))-pos)
Body1=split (Body, "<br>")
title = body1 (0)
theURL = body1 (2)
theURL = replace (theURL, "More results on", "")
Response.Write ("T:" & title)
Response.Write ("<br>")
Response.Write ("U:" & theURL)
Response.Write ("<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
PN = 0
PP = 0
Do while (true)
Strurl= "http://www.baidu.com/baidu?word=" &word& "&pn=" &cint (PN) +intbpn*10
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)
Bodytext=split (BodyText, "<table")
St = 5
Thei = 0
For i = 1 to 10
Thei = st + I
Response.Write (Thei)
Pos=instr (BodyText (thei), "&LT;TD")
Pos1=instr (BodyText (thei), "</td>")
Body=mid (BodyText (thei), Pos,len (BodyText (thei))-pos)
Pos3=instr (Body,url)
If POS3 > 0 Then
PP = pn + i
out = 1
Exit for
End If
Next

If out = 1 or PN = Then
Exit Do
End If
PN = CInt (PN) +10
Loop
If pp <> 0 Then
Response.Write ("<br><br> website <b> '" &url& "' </b> in search keyword <b> '" "&word&" " </b> in Baidu ranked rank <b> "&pp+intbpn*10&" </b> Bit ")
Else
Response.Write ("<br><br> website <b> '" &url& "' </b> in search keyword <b> '" "&word&" " </b> in Baidu ranked <font color=red> not in the "&intbpn*10+1&" name to "&intbpn*10+100&" in </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, website in Baidu rankings query </title>
Keywords, the site in Baidu ranking query:
<form name= "Form1" method= "Post" action= "Action=1" >
Url:
<input type= "text" name= "url" value= "<%=url%>" >
Key words:
<input type= "text" name= "word" value= "<%=word%>" >
Query scope:
<select name= "BPN" >
<option value= "0" <%if (BPN = "0") Then Response.Write ("selected") End if%>>1-100</option>
<option value= "Ten" <%if (BPN = "Ten") Then Response.Write ("selected") End if%>>101-200</option>
<option value= "<%if" (BPN = "") Then Response.Write ("selected") End if%>>201-300</option>
<option value= "<%if" (BPN = "") Then Response.Write ("selected") End if%>>301-400</option>
<option value= "<%if" (BPN = "") Then Response.Write ("selected") End if%>>401-500</option>
<option value= "<%if" (BPN = "a") Then Response.Write ("selected") End if%>>501-600</option>
<option value= "<%if" (BPN = "a") Then Response.Write ("selected") End if%>>601-700</option>
<option value= "<%if" (BPN = "a") Then Response.Write ("selected") End if%>>701-800</option>
<option value= "<%if" (BPN = "") Then Response.Write ("selected") End if%>>801-900</option>
<option value= "<%if" (BPN = "") Then Response.Write ("selected") End if%>>901-1000</option>
</select>
<input type= "Submit" name= "Submission" value= "submitted" >
</form>