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

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