ASP write Alexa ranking Query system tutorial Four

<%
On Error Resume Next
' if not chkpost () then
' Response.Write ' document.getElementById ("" Ranktoday ") . InnerHTML = ' <a href= ' "http://www.alixixi.com" ">www.alixixi.com</a>";
' Response.Write ' document.getElementById ("Rankwkavg"). InnerHTML = ' <a href= ' "http://www.alixixi.com" "> Www.alixixi.com</a> '; '
' Response.Write ' document.getElementById ("Rankmosavg"). InnerHTML = ' <a href= ' "http://www.alixixi.com" " >www.alixixi.com</a> '; '
' Response.Write ' document.getElementById ("Allrank"). InnerHTML = ' <a href= ' "http://www.alixixi.com" "> Www.alixixi.com</a> '; '
' Response.Write ' document.getElementById ("Rankmoschange"). InnerHTML = ' <a href= ' "http://www.alixixi.com" " >www.alixixi.com</a> '; '
' Response.End
' End If
Dim domain,dayrank,dimg,url,url1,strpage,strpage1
Dim Xmldom,sd,site
Dim Fcss,arrcss,aa,fimg1,fimg2,fimg3,arrrank
Dim alexacom,st1,st2
Dim Viewsmos

Domain = Request. QueryString ("url")
Dayrank = Request. QueryString ("Dayrank")
If InStr (Dayrank, "-") >0 Then
dimg = "Else
dimg = "End If
Dayrank = replace (Dayrank, "+", "")
Dayrank = replace (Dayrank, "-", "")
If domain = "" Then domain = "alixixi.com"
Domain = LCase (replace (domain, "www.", ""))
' Get CSS file style
Fcss = GetPage ("Http://client.alexa.com/common/css/scramble.css")
FCSS = replace (replace (FCSS,CHR (), ""), "{Display:none}", "")
Arrcss = Split (Fcss, ".")

' Get Rank page information
alexacom = GetPage ("http://www.alexa.com/data/details/traffic_details?url=" &domain& ")"
alexacom = Fixstr (alexacom, "Percent of global Internet users who visit this site", "<div id=" "Where_all" "class=" "Textof" F "" > ", 0)

' Circular filtering CSS Interference code and comment information
alexacom = replace (alexacom, <!--Did you know? Alexa offers this data programmatically.  Visit Http://aws.amazon.com/awis For more information about the Alexa Web I nformation service.--> "," ")
Alexacom = replace (alexacom," <tr><th>Yesterday</th><th> 1 wk avg.</th><th>3 mos. avg.</th><th>3 mos. change</th></tr> "" ")
AlexaCom = Replace (alexacom, "</td><td>", "|")

For AA = 0 To UBound (ARRCSS)
alexacom = replace (Alexacom,fixstr (alexacom, <span class= "" "&trim (ARRCSS (aa)) &" ">", "</span>" , 1), "" "
Response.Flush
Next
Response.Flush
For AA = 0 To UBound (ARRCSS)
alexacom = replace (Alexacom,fixstr (alexacom, <span class= "" "&trim (ARRCSS (aa)) &" ">", "</span>" , 1), "" "
Response.Flush
Next
Response.Flush
For AA = 0 To UBound (ARRCSS)
alexacom = replace (Alexacom,fixstr (alexacom, <span class= "" "&trim (ARRCSS (aa)) &" ">", "</span>" , 1), "" "
Response.Flush
Next
Response.Flush

' Extract flow ranking information and generate arrays
FIMG1 = Fixstr (alexacom, "src=" "http://client.alexa.com/common/images/", "" > ", 0)
If fimg1 <> "" Then fimg1 = " "

FIMG3 = Fixstr (alexacom, "the" of the number of unique pages viewed per user/day for this site, "</table>", 0)
FIMG3 = Fixstr (FIMG3, "src=" "http://client.alexa.com/common/images/", "" > ", 0)
If fimg3 <> "" Then fimg3 = " "

Fimg2 = Fixstr (alexacom, "Alexa traffic rank based on a combined measure of page views and users", "</table>", 0)
Fimg2 = Fixstr (Fimg2, "src=" "http://client.alexa.com/common/images/", "" > ", 0)
If fimg2 <> "" Then fimg2 = " "

alexacom = replace (replace (removehtml (Removespan (alexacom), ",", ""), "&nbsp;", "" "
alexacom = replace (alexacom, "", "")
alexacom = LCase (replace (ALEXACOM,CHR (10), ""))
Arrrank = Split (alexacom, "|")

Viewsmos = Split (Arrrank (9), "%") (0)
If InStr (Viewsmos, "*") Then
Viewsmos = Split (Viewsmos, "*") (0)
End If
' Response.Write Arrrank (9)
' Response.End

Dim D,dlist,domainmore,spmore
Domainmore = Trim (Split (Arrrank (9), "" &domain&: ") (1))
Domainmore = Trim (replace (Domainmore, "More ...", ""))
Domainmore = Split (domainmore, "%")
For D=0 to UBound (domainmore)-1
Spmore = Split (Domainmore (d), "-")

Dlist = dlist & <div class= ' mainbar2 ' ><div class= ' title ' style= ' width:374px ' > ' &trim (replace ( Domainmore (d), "-" &spmore (UBound (Spmore), "")) & "</div><div class= ' title2 ' style= ' width:374px '" > &trim (Spmore (UBound (Spmore)) & "%</div></div>"
Next
Dlist = Replace (dlist, "Other websites", "others")

' Response.Write dlist
' Response. End

The

  
Foreground displays the number of visitors per million
Response.Write "document.getElementById" ("Ranktoday"). InnerHTML = "" & Formatrank (Split (Arrrank (3), "(Reach)") (1)) & ""; &vbcrlf
Response.Write "document.getElementById (" "Rankwkavg"). InnerHTML = "" &formatrank (Arrrank (4)) & "" ";" &vbcrlf
Response.Write "document.getElementById (" "Rankmosavg"). InnerHTML = "" &formatrank (Arrrank (5)) & "" ";" &vbcrlf
Response.Write "document.getElementById (" "Allrank"). InnerHTML = "" &fimg1&formatrank ( Split (Arrrank (6), "page") (0)) & ""; &vbcrlf

The

Foreground displays page views per visitor
Response.Write "document.getElementById" ("Reachtoday"). InnerHTML = "" &formatrank ( Arrrank (0)) & ""; &vbcrlf
Response.Write "document.getElementById (" "Reachwkavg"). InnerHTML = "" &formatrank (Arrrank (1)) & "" ";" &vbcrlf
Response.Write "document.getElementById (" "Reachmosavg"). InnerHTML = "" &formatrank (Arrrank (2) ) & ""; &vbcrlf
Response.Write "document.getElementById" ("Reachmoschange"). InnerHTML = "" "&fimg2& FormatRank2 (Split (Arrrank (3), "Traffic") (0)) & ""; &vbcrlf
Response.Write "document.getElementById (" "Reachallchange"). InnerHTML = ""--";"

Response.Write "document.getElementById (" "Viewstoday" "). InnerHTML =" "" &formatrank (Split (Arrrank (6), "Site") (1 ) & ""; &vbcrlf
Response.Write "document.getElementById (" "Viewswkavg" "). InnerHTML =" "&formatrank (Arrrank (7)) &" "; &vbcrlf
Response.Write "document.getElementById (" "Viewsmosavg" "). InnerHTML =" "&formatrank (Arrrank (8)) &" "; &vbcrlf
Response.Write "document.getElementById (" "Viewsmoschange" "). InnerHTML =" "&fimg3&formatrank2 (Viewsmos) & "%" ";" &vbcrlf
Response.Write "document.getElementById" ("Viewsallchange"). InnerHTML = ""--""; &vbcrlf

Response.Write "document.getElementById" ("more"). InnerHTML = "" "&dlist&" ";" &vbcrlf

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 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 = no
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 ' All intercept (all take the front) (Place keyword)
strtemp = Right (str, Len (str)-INSTR (str, start)-Len (start) + 1)
strtemp = Left (strtemp, InStr (strtemp, last)-1)
Case Else ' is intercepted (both front) (Reserved keyword)
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

Public Function Chkpost ()
Dim server_v1,server_v2
Chkpost=false
Server_v1=cstr (Request.ServerVariables ("Http_referer"))
Server_v2=cstr (Request.ServerVariables ("SERVER_NAME"))
If Mid (Server_v1,8,len (SERVER_V2)) <>server_v2 Then
Chkpost=false
Else
Chkpost=true
End If
End Function

Function Removespan (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= "<span (. [ ^>]*) >|</span> "
Strtmp=objreg.replace (Strcontent, "")
Set objreg=nothing
Removespan=strtmp
Strtmp= ""
End Function

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

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 Formatrank (str)
Select Case str
 case "n/a*"
 formatrank = "Data not updated ..."
 case ""
 formatrank = "--"
 case "no change"
 formatrank = "unchanged"
 case else
 if IsN Umeric (str) then
 formatrank = Comma (str)
 elseif InStr (str, "%") >0 then
 str = FormatNumber (Trim (str), 8) *1000000
 formatrank = Comma (str)
 else
 formatrank = Trim (str)
 end If
End Select
End Function

Function FormatRank2 (str)
If InStr (str, ' no change ') then
str = ""
End If
Select Case STR
 case "n/a*"
 formatrank2 = "Data not updated ..."
 case "
 formatrank2 ="--"
 case" no change "
& nbsp FORMATRANK2 = "No change"
 case else
 if isnumeric (str) then
&NBSP;FORMATRANK2 = Comma (str)
 el SE
 formatrank2 = trim (str)
 end If
End Select
End Function
%>