asp获取alexa排名小偷源代码

2022-07-15 80酷酷网 80kuku.com

　　排名|源代码|alexa

1.通过xmlhttp读取该页面的内容，当然，我们也可以直接把这个页面保存到本地使用，但是我们不能保证alexa是否会重新修改该css样式，所以我们实时读取该页面的内容的方案比较可靠点，我们将页面内容存入变量strAlexaCss中。
      2.通过xmlhttp读取页面内容，alexa在显示排名的地方，会有如下代码，所以我们可以截取我们获得页面内容中的字符串，取和之中的内容。这样，我们就获得了：<span class="cfba">22</span><span class="c477">33</span>1,9<span class="cbea">36</span><span class="c120">25</span></span>这样的字符串，保存至变量rankcontent。
      3.我们得到所有的class属性，可以使用strspan=GetArray(rankcontent,"<span class=""","""",false,false) （其中getArray方法是大多数的采集代码中都有的函数。），并且得到数组aspan=split(strspan,"$Array$")。我们循环aspan这个数组，对于如果aspan(i)在字符串strAlexaCss中存在，则我们将该span标签和其中的内容替换为空，对于span的class不在strAlexaCss中存在的，我们只需要将span的左标签替换掉。这样，我们得到了22</span>1,9</span>25</span></span>这样的字符串。
      4.最后我们将字符串中所有的</span>替换为空，我们就得到了网站排名数据：221,925

以下是引用片段：
<%
’为了支持原创，请保留该处注释，谢谢！
’作者：草上飞
’博客地址：http://blog.linkhelper.cn/
’获取主域名
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

’==================================================
’函数名：ScriptHtml
’作  用：过滤html标记
’参  数：ConStr ------ 要过滤的字符串
’         TagName ------要过滤的标签
’         FType 1表示过滤左边标签  2表示过滤左右标签及中间的值  3表示过滤左边标签和右边标签，保留内容。
’==================================================
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&"
"
       ConStr=Re.Replace(ConStr,"")
       ’response.write server.htmlencode(constr)&"
"
    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

’==================================================
’函数名：GetBody
’作  用：截取字符串
’参  数：ConStr ------将要截取的字符串
’参  数：StartStr ------开始字符串
’参  数：OverStr ------结束字符串
’参  数：IncluL ------是否包含StartStr
’参  数：IncluR ------是否包含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&"
"&IncluL&"
"
   ’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

’==================================================
’函数名：GetArray
’作  用：提取链接地址，以$Array$分隔
’参  数：ConStr ------提取地址的原字符
’参  数：StartStr ------开始字符串
’参  数：OverStr ------结束字符串
’参  数：IncluL ------是否包含StartStr
’参  数：IncluR ------是否包含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(weburl)
    tempurl=getDomainUrl(weburl)
    ’读取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.-->","",false,false)
    ’获取其中的span的class
    strspan=GetArray(rankcontent,"<span class=""","""",false,false)
    ’response.write rankcontent&"
"
    ’response.write strspan&"
"
    ’response.end
    If strspan<>"$False$" Then
        aspan=split(strspan,"$Array$")

        For i=0 To UBound(aspan)
            ’response.write "."&aspan(i)
            ’判定aspan(i)即span的class是否在alexacss中存在，如果存在，则需要将这个span和span中的数据去掉。
            If InStr(strAlexaCss,"."&aspan(i))>=1 Then
                ’response.write aspan(i)&"
"
                ’response.end
                ’表示属性为none.需要替换掉。
                rankcontent=ScriptHtml(rankcontent,"span",2,aspan(i))
            Else
                rankcontent=ScriptHtml(rankcontent,"span",1,aspan(i))
            End if
        Next
        ’替换上面少去掉的右边的span标签。
        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 type="" name="url" value="<%=url%>" size=40> <input type="submit" value="查询">
</form>
<%
If url<>"" Then

    response.write "您的网站在ALEXA的排名为："
    response.flush
    rank=getAlexaRank(url)
    response.write rank
End if
%>