ASP crawl Alexa website World rankings Code
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, "<reach rank=" ") +13
Endd=instr (star,getsms, "</SD>")
Getstr=mid (getsms,star,endd-star-4)
Else
Getstr= "No rankings"
End If
If IsNumeric (getstr) =false then getstr= "No rankings"
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