ASP Alexa Inquiry Thief Program _ Thief/Collect

<%
' In order to support the original, please keep the comment, thank you!
' Author: Fly on the grass
' 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
%>