欧美在线观看一区二区三区,日韩精品在线免费观看,国自产拍亚洲免费视频

以下是源碼，請命名為.asp文件

復制代碼代碼如下:

<%
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&"' 關鍵詞在百度搜索排名中,前10位網站!</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,"上的更多結果","")
  response.write ("T:"& title)
  response.write ("<br>")
  response.write ("U:"& theurl)
  response.write ("<br><hr>")
next

Set oXMLHTTP = Nothing
if err.number<>0 then
response.write "出錯了，錯誤描述："&err.description & "<br>錯誤來源"& 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 For
  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><br>網站 <b>'"&url&"'</b> 在搜索關鍵詞 <b>'"&word&"'</b> 時在百度中排名名次第<b> "&pp+intbpn*10&" </b>位 ")
else
response.write("<br><br>網站 <b>'"&url&"'</b> 在搜索關鍵詞 <b>'"&word&"'</b> 時在百度中排名名次 <font color=red>未在"&intbpn*10+1&"名到"&intbpn*10+100&"內</font>")
end if

Set oXMLHTTP = Nothing
if err.number<>0 then
response.write "出錯了，錯誤描述："&err.description & "<br>錯誤來源"& 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), "'") '單引號過濾
   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>關鍵字,網站在百度中排名查詢</title>
<hr><hr><b>
關鍵字,網站在百度中排名查詢:
<form name="form1" method="post" action="?action=1">
  網址:
    <input type="text" name="url" value="<%=url%>">
關鍵字:
<input type="text" name="word" value="<%=word%>">
查詢范圍:
<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="提交">
</form>