asp版的alexa 查询系统

On Error Resume Next
Server.ScriptTimeOut = 9999999

Url = "http://data.alexa.com/data/?cli=10&dat=snba&ver=7.0&url="&Domain
'Url = "http://localhost/alexa.xml"
StrPage = GetBody(Url)
set xmldom=Server.CreateObject("MSXML2.DOMDocument")
xmldom.loadXML(StrPage)

Set RLS = xmldom.documentElement.selectSingleNode("RLS")
Set SD = xmldom.documentElement.selectSingleNode("SD")
Set DMOZ = xmldom.documentElement.selectSingleNode("DMOZ")

SiteRLNum = RLS.ChildNodes.length
For i = 0 To SiteRLNum - 1
 ReDim Preserve SiteRL(i),RLHref(i),RLTitle(i),RLDomain(i)
 Set SiteRL(i) = RLS.ChildNodes.item(i)
 RLHref(i) = SiteRL(i).attributes(0).value
 RLTitle(i) = SiteRL(i).attributes(1).value
 RLDomain(i) = replace(RLHref(i),"www.","")
 RLDomain(i) = replace(RLDomain(i),"/","")
Next

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")
SiteStreet = ADDR.attributes(0).value
SiteCity = ADDR.attributes(1).value
SiteZip = ADDR.attributes(2).value
SiteState = ADDR.attributes(3).value
SiteCountry = ADDR.attributes(4).value
SiteAddr = SiteStreet & SiteCity & SiteZip & SiteState & SiteCountry
SiteDate = CREATED.attributes(0).value
SitePhone = PHONE.attributes(0).value
SiteOwner = OWNER.attributes(0).value
SiteEmail = EMAIL.attributes(0).value
SiteLex = LANG.attributes(0).value
SiteCode = LANG.attributes(1).value
SiteLinksin = LINKSIN.attributes(0).value
SiteLinksin = Comma(SiteLinksin)
SiteSpeedText = SPEED.attributes(0).value
SiteSpeedText = Comma(SiteSpeedText)
SiteSpeedPct = SPEED.attributes(1).value
SiteSpeedPct = Comma(SiteSpeedPct)
SitePopularity = POPULARITY.attributes(1).value
SitePopularity = Comma(SitePopularity)
SiteRank = RANK.attributes(0).value
If instr(SiteRank,"-") > 0 Then
 ArrowImg = ""
ElseIf instr(SiteRank,"+") > 0 Then
 ArrowImg = ""
Else
 ArrowImg = ""
End If
SiteRank = Replace(SiteRank,"+","")
SiteRank = Replace(SiteRank,"-","")
If SiteRank = 0 Then
 ArrowImg = ""
End If
SiteRank = Comma(SiteRank)

Set SITE = DMOZ.selectSingleNode("SITE")
Set CATS = SITE.selectSingleNode("CATS")
Set CAT = CATS.selectSingleNode("CAT")
SiteTitle = SITE.attributes(1).value
SiteDesc = SITE.attributes(2).value
SiteCat = CAT.attributes(0).value

Dim fso,f,onames,oonames,otemp,onum
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.OpenTextFile( server.MapPath("cache.asp教程"), 1, True)
If f.AtEndOfStream = False Then
 onames = f.readline
End If
f.close
If fso.fileexists(server.MapPath("cache.asp")) = True Then
 fso.deletefile(server.MapPath("cache.asp"))
End If
Set f = fso.OpenTextFile( server.MapPath("cache.asp"), 8, True)
If isnull(onames) or len(trim(onames)) = 0 Then
 onames = "|"&Domain
ElseIf instr(onames,"|"&Domain) > 0 Then
 onames = replace(onames,"|"&Domain,"")
 onames = "|"&Domain&onames
Else
 onames = "|"&Domain&onames
End If
oonames = split(onames,"|")
otemp = ""
If UBound(oonames)>19 Then
 For i=1 To 20
  otemp = otemp&"|"&oonames(i)
 Next
 onum = 20
Else
 otemp = onames
 onum = UBound(oonames)
End If
f.write(trim(otemp))
f.close
Set f = Nothing

Dim ynames,yynames,ytemp,ynum
Set ynames = request.cookies("dnames")
If isnull(ynames) or len(trim(ynames)) = 0 Then
 ynames = "|"&Domain
ElseIf instr(ynames,"|"&Domain) > 0 Then
 ynames = replace(ynames,"|"&Domain,"")
 ynames = "|"&Domain&ynames
Else
 ynames = "|"&Domain&ynames
End If
yynames = split(ynames,"|")
ytemp = ""
If UBound(yynames) > 9 Then
 For i=1 To 10
  ytemp = ytemp&"|"&yynames(i)
 Next
 ynum = 10
Else
 ytemp = ynames
 ynum = UBound(yynames)
End If
response.cookies("dnames") = trim(ytemp)
response.cookies("dnames").expires = now() + 1

Function iswww(string)
 iswww = False
 Dim regEx,Matches
 Set regEx = New RegExp
 regEx.Pattern = "^[A-Za-z0-9]+(-+[A-Za-z0-9]+)*(.[A-Za-z]+)?.[A-Za-z]+$"
 regEx.IgnoreCase = True
 regEx.Global = True
 Set Matches = regEx.Execute(string)
 If Matches.Count Then
  iswww= True
 End If
End Function

Function GetBody(Url)
 On Error Resume Next
 Set xmlHttp = Server.CreateObject("Microsoft.XMLHTTP")
 With xmlHttp
  xmlHttp.Open "Get",Url,False,"",""
  xmlHttp.Send
  GetBody = xmlHttp.ResponseText
 End With
 Set xmlHttp = Nothing
End Function

Function Comma(str)
 If Not(IsNumeric(str)) Or 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 fget(str)
 str = Trim(str)
 Select Case str
  Case ""
   fget = "--"
  Case "-"
   fget = "--"
  Case Else
   fget = str
 End Select
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 1
   strTemp = Right(str, Len(str) - InStr(str, start) + 1)
   strTemp = Left(strTemp, InStr(strTemp, last) + Len(last) - 1)
  Case 2
   strTemp = Right(str, Len(str) - InStr(str, start) + 1)
   strTemp = Left(strTemp, InStr(strTemp, last) - 1)
  Case Else
   strTemp = Right(str, Len(str) - InStr(str, start) - Len(start) + 1)
   strTemp = Left(strTemp, InStr(strTemp, last) + Len(last) - 1)
  End Select
 Else
  strTemp = ""
 End If
FixStr = strTemp
End Function

Function RegStr(ByVal str, ByVal start, ByVal last, ByVal n)
 Dim regEx,Match,Matches,strTemp(),i
 i = 0
 Set regEx = New RegExp
 regEx.Pattern = start & "[^<>/]*" & last
 regEx.IgnoreCase = False
 regEx.Global = True
 Set Matches = regEx.Execute(str)
 For Each Match in Matches
  Select Case n
  Case 0
   ReDim Preserve  strTemp(i)
   strTemp(i) = Replace(Match.Value,start,"")
   strTemp(i) = Replace(strTemp(i),last,"")
  Case Else
   ReDim Preserve  strTemp(i)
   strTemp(i) = Match.Value
  End Select
  i = i + 1
 Next
 RegStr = strTemp
End Function
%>








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

 

    广告招租↓
 

 

  
   
       
   
  

本站PR4啦,友情链接招租(40元/月): 858261598 QQ群：21721306 友情提示：查询后的地址为友情地址，来访一次左边自动第一名！

 

 

    网站 www.<%=domain%> 日平均Alexa排名走势图
  [点击时间段查看相应时段曲线]
 

 

  
   
    
    
    
    
    
   
   
    
   
  

六个月平均排名曲线	三个月平均排名曲线	一个月平均排名曲线	半个月平均排名曲线	一星期平均排名曲线

 

 

    友情链接↓
 

 

  
   
       
   
  

广州网站优化┊免费网站推广┊搜索引擎收录查询┊Alexa排名查询┊今天到期域名查询┊欣诚科技服务┊深圳太阳能公司┊广州华帝专卖店 广州网站制作┊软膜天花┊广州服饰批发┊广州蛋糕DIY制作培训┊番禺太阳能工程┊广州3M净水器┊美的热泵热水器┊广州大金空调┊服装批发 本站PR4啦,友情链接招租(40元/月): 858261598 QQ群：21721306 友情提示：查询后的地址为友情地址，来访一次左边自动第一名！