asp.net_asp 抓取alexa 网站世界排名代码

更新时间：2016-04-06 来源：php常用代码手机版 字体：大中小

【www.bbyears.com--php常用代码】

asp 抓取alexa 网站世界排名代码

function Alexa(AlexaURL)
on error resume next
dim getsms,getstr,url
dim star,endd
url="http://data.alexa.com/data?cli=10&dat=snba&url="&AlexaURL
getsms=getHTTPPage(url)
if getsms<>"" then
  star=instr(getsms,"   endd=instr(star,getsms,"")
  getstr=mid(getsms,star,endd-star-4)
else
  getstr="无排名"
end if
if IsNumeric(getstr)=false then getstr="无排名"
Alexa=getstr
end function
function getHTTPPage(url)
on error resume next
dim http
set http=Server.createobject("Microsoft.XMLHTTP")
Http.open "GET",url,false
Http.send()
if Http.readystate<>4 then
  getHTTPPage=""
  exit function
end if
getHTTPPage=bytes2BSTR(Http.responseBody)
set http=nothing
if err.number<>0 then err.Clear
end function
Function bytes2BSTR(vIn)
dim strReturn
dim i1,ThisCharCode,NextCharCode
strReturn = ""
For i1 = 1 To LenB(vIn)
  ThisCharCode = AscB(MidB(vIn,i1,1))
  If ThisCharCode < &H80 Then
   strReturn = strReturn & Chr(ThisCharCode)
  Else
   NextCharCode = AscB(MidB(vIn,i1+1,1))
   strReturn = strReturn & Chr(CLng(ThisCharCode) * &H100 + CInt(NextCharCode))
   i1 = i1 + 1
  End If
Next
bytes2BSTR = strReturn
    Err.Clear
End Function