可以查询百度排名的asp源码放送了
来源：
中文源码网 浏览：300 次 日期：2024-05-17 23:57:39
【下载文档: 可以查询百度排名的asp源码放送了.txt 】
可以查询百度排名的asp源码放送了
以下是源码，请命名为.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("
'"&word&"' 关键词在百度搜索排名中,前10位网站!") 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,"
") BodyText=mid(BodyText,pos,pos1) BodyText=split(BodyText,"") Body=mid(BodyText(thei),pos,len(BodyText(thei))-pos) body1=split(body,"
") title = body1(0) theurl = body1(2) theurl = replace(theurl,"上的更多结果","") response.write ("T:"& title) response.write ("
") response.write ("U:"& theurl) response.write ("
") next Set oXMLHTTP = Nothing if err.number<>0 then response.write "出错了，错误描述："&err.description & "
错误来源"& 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&"
") oXMLHTTP.open "GET",strurl,False oXMLHTTP.send BodyText=oXMLHTTP.responsebody BodyText=BytesToBstr(BodyText,"gb2312") Pos=Instr(BodyText,"") BodyText=mid(BodyText,pos,pos1) BodyText=split(BodyText,"") 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("
网站 '"&url&"' 在搜索关键词 '"&word&"' 时在百度中排名名次 第 "&pp+intbpn*10&" 位 ") else response.write("
网站 '"&url&"' 在搜索关键词 '"&word&"' 时在百度中排名名次 未在"&intbpn*10+1&"名到"&intbpn*10+100&"内") end if Set oXMLHTTP = Nothing if err.number<>0 then response.write "出错了，错误描述："&err.description & "
错误来源"& 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), " ") fString = Replace(fString, CHR(10), "
") HTMLEncode = fString End If End Function %>
关键字,网站在百度中排名查询
关键字,网站在百度中排名查询:
