asp alexa查询小偷程序

<%
'为了支持原创，请保留该处注释，谢谢！
'作者：草上飞
'获取主域名
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
%>