The following is the source code. Please name it the. asp file.
Copy codeThe Code is 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 ranking, top 10 websites! </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), "<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, 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), "<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
End if
Next
If out = 1 or pn = 90 then
Exit do
End if
Pn = cint (pn) + 10
Loop
If pp <> 0 then
Response. write ("<br> website <B> '" & url & "' </B> Search for keywords <B> '" & word & "' </B> ranking No. <B> "& pp + intbpn * 10 &" </B> "in Baidu ")
Else
Response. write ("<br> website <B> '" & url & "' </B> Search for keywords <B> '" & word & "' </B> ranking in Baidu <font color = red> not in "& intbpn * 10 + 1 &" name to "& intbpn * 10 + 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 Baidu </title>
<Hr> <B>
Keyword, ranking of websites in Baidu:
<Form name = "form1" method = "post" action = "? Action = 1 ">
URL:
<Input type = "text" name = "url" value = "<% = url %>">
Keywords:
<Input type = "text" name = "word" value = "<% = word %>">
Query range:
<Select name = "bpn">
<Option value = "0" <% if (bpn = "0") then response. write ("selected") end if %> 1-100 </option>
<Option value = "10" <% if (bpn = "10") then response. write ("selected") end if %> 101-200 </option>
<Option value = "20" <% if (bpn = "20") then response. write ("selected") end if %> 201-300 </option>
<Option value = "30" <% if (bpn = "30") then response. write ("selected") end if %> 301-400 </option>
<Option value = "40" <% if (bpn = "40") then response. write ("selected") end if %> 401-500 </option>
<Option value = "50" <% if (bpn = "50") then response. write ("selected") end if %> 501-600 </option>
<Option value = "60" <% if (bpn = "60") then response. write ("selected") end if %> 601-700 </option>
<Option value = "70" <% if (bpn = "70") then response. write ("selected") end if %> 701-800 </option>
<Option value = "80" <% if (bpn = "80") then response. write ("selected") end if %> 801-900 </option>
<Option value = "90" <% if (bpn = "90") then response. write ("selected") end if %> 901-1000 </option>
</Select>
<Input type = "submit" name = "Submit" value = "submit">
</Form>