ASP get Alexa rank thief source code

Rank | source code |alexa

1. Read http://client.alexa.com/common/css/through XMLHTTP Scramble.css the content of the page, of course, we can also directly save this page to use locally, but we do not guarantee that Alexa will modify the CSS style, so we read the http://client.alexa.com/common/in real time Css/scramble.css the content of the page is more reliable, we store the content of the page in variable STRALEXACSS.
2. Read http://www.alexa.com/data/details/traffic_details/www.newbooks.com.cn page content through XMLHTTP, Alexa in the display ranking place, there will be the following code <!--Did you know?  Alexa offers this data programmatically. Visit Http://aws.amazon.com/awis For more information about the Alexa Web information service.-->, So we can intercept the string that we get in the page content, take <!--Did you know?  Alexa offers this data programmatically. Visit Http://aws.amazon.com/awis For more information about the Alexa Web information service.--> and <!--Google_ad_se The contents of Ction_end (Name=default)-->. In this way, we get: <span class= "CFBA" >22</span><span class= "c477" >33</span>1,9<span class= "Cbea" ">36</span><span class=" c120 ">25</span></span> string, save to variable rankcontent.
3. We get all class attributes, we can use Strspan=getarray (rankcontent, "<span class=" "", "" ", False,false) (The GetArray method is a function in most collection codes.) and gets the array aspan=split (Strspan, "$Array $"). We loop Aspan this array, and for if Aspan (i) exists in the string stralexacss, we replace the span label and the contents of it with null, and the span class does not exist in Stralexacss, We just need to replace the left label of span. So, we get a string like 22</span>1,9</span>25</span></span>.
4. Finally we will replace all the </span> in the string with NULL, we get the site ranking data: 221,925

The following is a reference fragment: <% ' In order to support the original, please keep the comment, thank you! ' Author: Fly on the grass ' Blog address: http://blog.linkhelper.cn/ ' Get the primary domain Function getdomainurl (URL) Tempurl=replace (URL, "http://", "") If InStr (Tempurl, "/") >0 Then Tempurl=left (Tempurl,instr (Tempurl, "/")-1) End If Getdomainurl=tempurl End Function Function Gethttppage (Httpurl) If IsNull (Httpurl) =true or Len (httpurl) <18 or httpurl= "$False $" Then Gethttppage= "$False $" Exit Function End If Dim Http Set http=server.createobject ("MSXML2. XMLHTTP ") Http.open "Get", Httpurl,false Http.send () If Http.readystate<>4 Then Set http=nothing Gethttppage= "$False $" Exit function End If Gethttppage=http.responsetext Set http=nothing If Err.number<>0 Then Err.Clear End If End Function ' ================================================== ' Function name: scripthtml ' Function: Filter HTML tags ' Parameter: constr------The string to filter ' TagName------the label to filter ' FType 1 means that filtering the left label 2 means filtering the left and right tabs and the middle value of 3, which preserves the contents. ' ================================================== Function scripthtml (Byval constr,tagname,ftype,includestr) Dim Re Set re=new REGEXP Re.ignorecase =true Re.global=true Select Case FType Case 1 Re.pattern= "<" & TagName & ([^>]) * ("&includestr&") {1,} ([^>]) *> " Constr=re.replace (Constr, "") Case 2 Re.pattern= "<" & TagName & ([^>]) * ("&includestr&") {1,} ([^>]) *>.*?</"& TagName & "([^>]) *>" ' Response.Write constr& ' <br> ' Constr=re.replace (Constr, "") ' Response.Write Server.HTMLEncode (constr) & "<br>" Case 3 Re.pattern= "<" & TagName & ([^>]) * ("&includestr&") {1,} ([^>]) *> " Constr=re.replace (Constr, "") Re.pattern= "</" & TagName & "([^>]) *>" Constr=re.replace (Constr, "") End Select Scripthtml=constr Set re=nothing End Function ' ================================================== ' Function name: getbody ' function: Intercept string ' Parameter: constr------the string to intercept ' Parameter: startstr------start string ' Parameter: overstr------End String ' Parameter: Inclul------contains STARTSTR ' Parameter: Inclur------contains OVERSTR ' ================================================== Function GetBody (Constr,startstr,overstr,inclul,inclur) If constr= "$False $" or constr= "" or IsNull (constr) =true or startstr= "" or IsNull (STARTSTR) =true or overstr= "" or IsNull (Ov ERSTR) =true Then Getbody= "$False $" Exit Function End If Dim constrtemp Dim Start,over Constrtemp=lcase (CONSTR) Startstr=lcase (STARTSTR) Overstr=lcase (OVERSTR) Start = InStrB (1, Constrtemp, Startstr, Vbbinarycompare) "Response.Write start&" <br> "&IncluL&" <br> " ' Response.End If Start<=0 Then Getbody= "$False $" Exit Function Else If Inclul=false Then Start=start+lenb (STARTSTR) End If End If OVER=INSTRB (Start,constrtemp,overstr,vbbinarycompare) ' Response.Write over ' Response.End "Response.Write start&" "&Over&" "&over-start ' Response.End If over<=0 Or Over<=start Then Getbody= "$False $" Exit Function Else If inclur=true Then Over=over+lenb (OVERSTR) End If End If GETBODY=MIDB (Constr,start,over-start) ' Response.Write GetBody ' Response.End End Function ' ================================================== ' Function name: GetArray ' Function: Extract link address, separated by $array$ ' Parameter: Constr------Extract the original character of the address ' Parameter: startstr------start string ' Parameter: overstr------End String ' Parameter: Inclul------contains STARTSTR ' Parameter: Inclur------contains OVERSTR ' ================================================== Function GetArray (Byval constr,startstr,overstr,inclul,inclur) If constr= "$False $" or constr= "" or IsNull (constr) =true or startstr= "" or overstr= "" "or IsNull (STARTSTR) =true or IsNull (O VERSTR) =true Then Getarray= "$False $" Exit Function End If Dim Tempstr,tempstr2,objregexp,matches,match Tempstr= "" Set objRegExp = New Regexp Objregexp.ignorecase = True Objregexp.global = True Objregexp.pattern = "(" &StartStr& "). +? ("&OverStr&") " Set matches =objregexp.execute (CONSTR) For the Match in matches Tempstr=tempstr & "$Array $" & Match.value Next Set matches=nothing If tempstr= "" Then Getarray= "$False $" Exit Function End If Tempstr=right (Tempstr,len (TEMPSTR)-7) If Inclul=false Then Objregexp.pattern =startstr Tempstr=objregexp.replace (TempStr, "") End If If Inclur=false Then Objregexp.pattern =overstr Tempstr=objregexp.replace (TempStr, "") End If Set objregexp=nothing Set matches=nothing If tempstr= "" Then Getarray= "$False $" Else Getarray=tempstr End If End Function Function Getalexarank (Weburl) Tempurl=getdomainurl (Weburl) ' Read the data in the HTTP://CLIENT.ALEXA.COM/COMMON/CSS/SCRAMBLE.CSS Alexacss= "Http://client.alexa.com/common/css/scramble.css" Stralexacss=gethttppage (ALEXACSS) ' Response.Write stralexacss ' Response.End Alexarankqueryurl= "http://www.alexa.com/data/details/traffic_details/" &tempurl Stralexacontent=gethttppage (Alexarankqueryurl) Rankcontent=getbody (stralexacontent, "Information service.-->", "<!--google_ad_section_end (Name=default)-- > ", False,false) ' Get the span of one of the class Strspan=getarray (Rankcontent, "<span class=" "", "" "", False,false) ' Response.Write rankcontent& ' <br> ' ' Response.Write strspan& ' <br> ' ' Response.End If strspan<> "$False $" Then Aspan=split (Strspan, "$Array $") For i=0 to UBound (Aspan) ' Response.Write '. " &aspan (i) ' Determine whether Aspan (i) is a span class that exists in alexacss, and if so, remove the data from this span and span. If InStr (Stralexacss, "." &aspan (i)) >=1 Then ' Response.Write Aspan (i) & "<br>" ' Response.End ' Indicates that the property is none. Need to be replaced. Rankcontent=scripthtml (rankcontent, "span", 2,aspan (i)) Else Rankcontent=scripthtml (rankcontent, "span", 1,aspan (i)) End If Next ' Replace the span label on the right side of the less-removed top. Rankcontent=replace (rankcontent, "</span>", "") End If If rankcontent= "$False $" Then rankcontent= "No Data" End If Getalexarank=replace (Rankcontent, ",", "") End Function url=request.querystring ("url") %> <form name= "Alexaform" method=get> Input URL: <input type= "name=" url "value=" <%=url%> "size=40> <input type=" Submit "value=" Query "> </form> <% If url<> "" Then Response.Write "Your site in Alexa ranked as:" Response.Flush Rank=getalexarank (URL) Response.Write Rank End If %>