asp alexa查询程序代码

<%
'******************************

'******************************
Dim domain,Url,Url1,strPage,StrPage1
Dim xmldom,SD,SITE,dimg
domain = request.QueryString("url")
if domain = "" then domain = "111com.net"
If Not iswww(domain) Then
response.write ""
domain = "111com.net"
End if
host = "http://www.111com.net"
if left(domain,7)="http://" then
 domain=right(domain,len(domain)-7)
end if
if instr(domain,"/")<>0 then
 domain=left(domain,instr(domain,"/")-1)
end if
on error resume Next
Function iswww(strng)
    iswww = false
    Dim regEx, Match
    Set regEx = New RegExp
    regEx.Pattern = "^w+((-w+)|(.w+))*[A-Za-z0-9]+((.|-)[A-Za-z0-9]+)*.[A-Za-z]+$"
    regEx.IgnoreCase = True
    Set Match = regEx.Execute(strng)
    if match.count then iswww= true
End Function

Function GetPage(Path)
        t = GetBody(Path)
        GetPage=BytesToBstr(t,"UTF-8")
End function

Function GetPage2(Path)
        t = GetBody(Path)
        GetPage2=BytesToBstr(t,"GB2312")
End function

Function GetBody(url)
        on error resume next
        Set Retrieval = CreateObject("Microsoft.XMLHTTP")
        With Retrieval
        .Open "Get", url, False, "", ""
        .Send
        GetBody = .ResponseBody
        End With
        Set Retrieval = Nothing
End Function

function fget(str)
select case trim(str)
 case ""
 fget = "--"
 case else
 fget = str
end select
end function
Function BytesToBstr(body,Cset)
        dim objstream
        set objstream = Server.CreateObject("adodb.stream")
        objstream.Type = 1
        objstream.Mode =3
        objstream.Open
        objstream.Write body
        objstream.Position = 0
        objstream.Type = 2
        objstream.Charset = Cset
        BytesToBstr = objstream.ReadText
        objstream.Close
        set objstream = nothing
End Function

Function FixStr(ByVal str, ByVal start, ByVal last, ByVal n)
Dim strTemp
On Error Resume Next
If InStr(str, start) > 0 Then
Select Case n
Case 0
strTemp = Right(str, Len(str) - InStr(str, start) - Len(start) + 1)
strTemp = Left(strTemp, InStr(strTemp, last) - 1)
Case Else
strTemp = Right(str, Len(str) - InStr(str, start) + 1)
strTemp = Left(strTemp, InStr(strTemp, last) + Len(last) - 1)
End Select
Else
strTemp = ""
End If
FixStr = strTemp
End Function
Function Comma(str)
If Not(IsNumeric(str)) Or str = 0 Then
Result = 0
ElseIf Len(Fix(str)) < 4 Then
Result = str
Else
Pos = Instr(1,str,".")
If Pos > 0 Then
Dec = Mid(str,Pos)
End if
Res = StrReverse(Fix(str))
LoopCount = 1
While LoopCount <= Len(Res)

TempResult = TempResult + Mid(Res,LoopCount,3)
LoopCount = LoopCount + 3
If LoopCount <= Len(Res) Then
TempResult = TempResult + ","
End If
Wend
Result = StrReverse(TempResult) + Dec
End If
Comma = Result
End Function

Function lens(txt, length)
        Dim x, y, ii
        txt = Trim(txt)
        x = Len(txt)
        y = 0
        If x >= 1 Then
            For ii = 1 To x
                If Asc(Mid(txt, ii, 1)) < 0 Or Asc(Mid(txt, ii, 1)) > 255 Then
                    y = y + 2
                Else
                    y = y + 1
                End If
                If y >= length Then
                    txt = Left(Trim(txt), ii-3) & "..."
                    Exit For
                End If
            Next
            lens = txt
        Else
            lens = ""
        End If
End Function

Url = "http://data.alexa.com/data/?cli=10&dat=snba&ver=7.0&url="&Domain
strPage = GetPage(Url)
set xmldom=server.createobject("MSXML2.DOMDocument")  
xmldom.loadXML(strPage)
Set SD = xmldom.documentElement.selectSingleNode("SD")
Set SITE = xmldom.documentElement.selectSingleNode("DMOZ")
Dim ADDR
Dim CREATED
Dim PHONE
Dim OWNER
Dim EMAIL
Dim LANG
Dim LINKSIN
Dim SPEED
Dim POPULARITY
Dim RANK
Dim CHILD
Dim REACH
Set ADDR = SD.selectSingleNode("ADDR")
Set CREATED = SD.selectSingleNode("CREATED")
Set PHONE = SD.selectSingleNode("PHONE")
Set OWNER = SD.selectSingleNode("OWNER")
Set EMAIL = SD.selectSingleNode("EMAIL")
Set LANG = SD.selectSingleNode("LANG")
Set LINKSIN = SD.selectSingleNode("LINKSIN")
Set SPEED = SD.selectSingleNode("SPEED")
Set POPULARITY = SD.selectSingleNode("POPULARITY")
Set RANK = SD.selectSingleNode("RANK")
Set CHILD = SD.selectSingleNode("CHILD")
Set REACH = SD.selectSingleNode("REACH")

Dim SITEINFO
Dim CATS
Dim SiteTitle
Dim SiteDesc
Dim Cat
Set SITEINFO = SITE.selectSingleNode("SITE")
Set CATS = SITEINFO.selectSingleNode("CATS").selectSingleNode("CAT")
SiteTitle = SITEINFO.attributes(1).value
SiteDesc = SITEINFO.attributes(2).value
Cat = CATS.attributes(1).value

Dim COUNTRY
Dim ZIP
Dim STATE
Dim CITY
Dim STREET
STREET = ADDR.attributes(0).value
CITY = ADDR.attributes(1).value
ZIP = ADDR.attributes(2).value
STATE = ADDR.attributes(3).value
COUNTRY = ADDR.attributes(4).value

Dim xDate
Dim xPhone
Dim xOwner
Dim xEmail
Dim xLex
Dim xCode
Dim xLinksin
Dim xSpeed
Dim xPct
Dim xPopularity
Dim xRank
Dim xChild
Dim xReach  
xDate = CREATED.attributes(0).value
xPhone = PHONE.attributes(0).value
xOwner = OWNER.attributes(0).value
xEmail  = EMAIL.attributes(0).value
xLex  = LANG.attributes(0).value
xCode = LANG.attributes(1).value
xLinksin = LINKSIN.attributes(0).value
xSpeed  = SPEED.attributes(0).value
xPct  = SPEED.attributes(1).value
xPopularity = POPULARITY.attributes(1).value
xPopularity = Comma(xPopularity)
xRank = RANK.attributes(0).value
if instr(xRank,"-")>0 then
dimg = ""
else
dimg = ""
end if
xRank = replace(xRank,"+","")
xRank = replace(xRank,"-","")
xRank = Comma(xRank)

xChild = CHILD.attributes(0).value
xReach = REACH.attributes(0).value  

Public Function RemoveHtml(byval strContent)
 Dim objReg ,strTmp
 If strContent="" OR ISNull(strContent) Then Exit Function
  
 Set objReg=new RegExp
 objReg.IgnoreCase =True
 objReg.Global=True
 objReg.Pattern="<(.[^>]*)>"
 strTmp=objReg.Replace(strContent, "")
 Set objReg=Nothing
 RemoveHtml=strTmp
 strTmp=""
End Function

Dim SitePic
Dim pm6,pm3,pm1,pday15,pday7
Dim tmp1
Dim t_arr
Dim t_day,t_wk1,t_m3,t_m3_change

pm6 = "http://traffic.alexa.com/graph?w=700&h=280&r=6m&y=t&u="&Domain
pm3 = "http://traffic.alexa.com/graph?w=700&h=280&r=3m&y=t&u="&Domain
pm1 = "http://traffic.alexa.com/graph?w=700&h=280&r=1m&y=t&u="&Domain
pday15 = "http://traffic.alexa.com/graph?w=700&h=280&r=15.0m&y=t&u="&Domain
pday7 = "http://traffic.alexa.com/graph?w=700&h=280&r=7.0m&y=t&u="&Domain

set tnames = request.cookies("dnames")
if isnull(tnames) or len(trim(tnames))=0 then
 tnames = domain&"|"
else
 if instr(tnames,domain)>0 then
  names = replace(tnames,domain&"|","")
 else
  tnames = domain&"|"&tnames
 end if
end If

ttnames = split(tnames,"|")
tmpncontent = ""

if ubound(ttnames)>5 then
 for tat=0 to 4
  tmpncontent = tmpncontent&ttnames(tat)&"|"
 next
else
 tmpncontent=tnames
end If

response.cookies("dnames") = trim(tmpncontent)
response.cookies("dnames").expires = now()+1

%>

css" rel="stylesheet" type="text/css" />

 

流量排名数据信息：Traffic Rank for <%=domain%>

 

   

昨日排名

   

一周平均

   

三月平均

   

三月变化趋势

   

综合排名变化

 

 

   

   

   

   

   

<%=dimg&fget(xRank)%>

 

 

每百万人中访问数：Reach for <%=domain%>

 

   

昨日数据

   

一周平均

   

三月平均

   

三月变化趋势

   

综合排名变化

 

 

   

   

   

   

   

 

 

每访问者浏览页数：Page Views per user for <%=domain%>

 

   

昨日数据

   

一周平均

   

三月平均

   

三月变化趋势

   

综合排名变化

 

 

   

   

   

   

   

 

 

<%=SiteTitle%> 下属站点被访问比例

 

   

子域名

   

访问比例