Do many friends don’t understand the thief program? Do you know what the thief program is? Today, let’s take a look at how Asp Alexa can implement the query thief program with the editor of Foxin. In fact, this problem is not as difficult as we imagined.
<%
'In order to support originality, please keep the comments here, thank you!
'Author: Cao Shangfei
'Get the main domain name
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
'Arguments: ConStr -----------------------------------------------------------------------------------------------------------------------
' TagName ------- Tags to be filtered
' FType 1 means filtering the left label 2 means filtering the left label and the middle value 3 means filtering the left label and the right label, retaining the content.
'====================================================================
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
'Effect: Intercept the string
'Argument: ConStr -------The string to be intercepted
'Arguments: StartStr ------Start String
'Arguments: OverStr -------End String
'Article: IncluL ------- Whether to include StartStr
'Article: IncluR ---------Include 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(OverStr)=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
'Method: Extract the link address, separated by $Array$
'Argument: ConStr -------Extract the original character of the address
'Arguments: StartStr ------Start String
'Arguments: OverStr -------End String
'Article: IncluL ------- Whether to include StartStr
'Article: IncluR ---------Include 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(OverStr)=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 Each 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(webuurl)
tempurl=getDomainUrl(wewebrl)
'Read data from 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 class of the span in it
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), i.e., the class of span exists in alexacss. If it exists, the data in span and span needs to be removed.
If InStr(strAlexaCss,"."&aspan(i))>=1 Then
'response.write aspan(i)&"<br>"
'response.end
' means that the property is none. It needs to be replaced.
rankcontent=ScriptHtml(rankcontent,"span",2,aspan(i))
Else
rankcontent=ScriptHtml(rankcontent,"span",1,aspan(i))
End if
Next
'Replace the span tag on the right that is less removed above.
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>
Enter the URL: <input type="" name="url" value="<%=url%>" size=40> <input type="submit" value="query">
</form>
<%
If url<>"" Then
response.write "Your website ranks at ALEXA as:"
response.flush
rank=getAlexaRank(url)
response.write rank
End if
%>
The above is about how asp alexa can query thief program. This article introduces a relatively simple alexa thief program. Friends who like this function can learn its principles. I believe that you can write this program soon.