Baidu can be queried to rank the source of the ASP to send the application skills

The following is the source code, please name the. asp file

Copy Code code as follows:

<%
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 Word <> "" then
GetCategories ()
If URL <> "" Then
GetCategories2 ()
End If
End If
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>