可以查詢百度排名的asp源碼放送了

2024-05-04 10:58:22

字體：大中小

供稿：網(wǎng)友

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

復(fù)制代碼代碼如下:

<%
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("'"&word&"' 關(guān)鍵詞在百度搜索排名中,前10位網(wǎng)站! ")

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," ")

 title = body1(0)
 theurl = body1(2)
 theurl = replace(theurl,"上的更多結(jié)果","")
 response.write ("T:"& title)
 response.write (" ")
 response.write ("U:"& theurl)
 response.write (" <hr>")
next

Set oXMLHTTP = Nothing
if err.number<>0 then
response.write "出錯(cuò)了，錯(cuò)誤描述："&err.description & " 錯(cuò)誤來源"& 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")

上一篇：利用ASPUPLOAD，ASPJPEG實(shí)現(xiàn)圖片上傳自動生成縮略圖及加上水印

下一篇：javascript asp教程第四課同時(shí)使用vbscript和javascript

發(fā)表評論

共有條評論