asp擷取alexa排名小偷原始碼

來源:互聯網
上載者:User
排名|原始碼|alexa

1.通過xmlhttp讀取http://client.alexa.com/common/css/scramble.css該頁面的內容,當然,我們也可以直接把這個頁面儲存到本地使用,但是我們不能保證alexa是否會重新修改該css樣式,所以我們即時讀取http://client.alexa.com/common/css/scramble.css該頁面的內容的方案比較可靠點,我們將頁面內容存入變數strAlexaCss中。
        2.通過xmlhttp讀取http://www.alexa.com/data/details/traffic_details/www.newbooks.com.cn頁面內容,alexa在顯示排名的地方,會有如下代碼<!--Did you know? Alexa offers this data programmatically.  Visit http://aws.amazon.com/awis for more information about the Alexa Web Information Service.-->,所以我們可以截取我們獲得頁面內容中的字串,取<!--Did you know? Alexa offers this data programmatically.  Visit http://aws.amazon.com/awis for more information about the Alexa Web Information Service.-->和<!-- google_ad_section_end(name=default) -->之中的內容。這樣,我們就獲得了:<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&"<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

’==================================================
’函數名: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&"<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

’==================================================
’函數名: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.-->","<!-- google_ad_section_end(name=default) -->",false,false)
    ’擷取其中的span的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)
            ’判定aspan(i)即span的class是否在alexacss中存在,如果存在,則需要將這個span和span中的資料去掉。
            If InStr(strAlexaCss,"."&aspan(i))>=1 Then
                ’response.write aspan(i)&"<br>"
                ’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
%>



相關文章

E-Commerce Solutions

Leverage the same tools powering the Alibaba Ecosystem

Learn more >

Apsara Conference 2019

The Rise of Data Intelligence, September 25th - 27th, Hangzhou, China

Learn more >

Alibaba Cloud Free Trial

Learn and experience the power of Alibaba Cloud with a free trial worth $300-1200 USD

Learn more >

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。