asp alexa查询小偷程序

　　<%
为了支持原创，请保留该处注释，谢谢！
作者：草上飞
获取主域名
FunctiongetDomainUrl(url)
tempurl=replace(url,
ifinstr(tempurl,/)>0then
tempurl=left(tempurl,instr(tempurl,/)-1)
endIf
getDomainurl=tempurl
EndFunction


FunctionGetHttpPage(HttpUrl)
IfIsNull(HttpUrl)=TrueOrLen(HttpUrl)<18OrHttpUrl=$False$Then
GetHttpPage=$False$
ExitFunction
EndIf
DimHttp
SetHttp=server.createobject(MSXML2.XMLHTTP)
Http.openGET,HttpUrl,False
Http.Send()
IfHttp.Readystate<>4then
SetHttp=Nothing
GetHttpPage=$False$
Exitfunction
Endif
GetHTTPPage=Http.responseText
SetHttp=Nothing
IfErr.number<>0then
Err.Clear
EndIf
EndFunction

==================================================
函数名：ScriptHtml
作用：过滤html标记
参数：ConStr------要过滤的字符串
TagName------要过滤的标签
FType1表示过滤左边标签2表示过滤左右标签及中间的值3表示过滤左边标签和右边标签，保留内容。
==================================================
FunctionScriptHtml(ByvalConStr,TagName,FType,includestr)
DimRe
SetRe=newRegExp
Re.IgnoreCase=true
Re.Global=True
SelectCaseFType
Case1
Re.Pattern=<&TagName&([^>])*(&includestr&){1,}([^>])*>
ConStr=Re.Replace(ConStr,)
Case2
Re.Pattern=<&TagName&([^>])*(&includestr&){1,}([^>])*>.*?</&TagName&([^>])*>
response.writeconstr&<br>
ConStr=Re.Replace(ConStr,)
response.writeserver.htmlencode(constr)&<br>
Case3
Re.Pattern=<&TagName&([^>])*(&includestr&){1,}([^>])*>
ConStr=Re.Replace(ConStr,)
Re.Pattern=</&TagName&([^>])*>
ConStr=Re.Replace(ConStr,)
EndSelect
ScriptHtml=ConStr
SetRe=Nothing
EndFunction

==================================================
函数名：GetBody
作用：截取字符串
参数：ConStr------将要截取的字符串
参数：StartStr------开始字符串
参数：OverStr------结束字符串
参数：IncluL------是否包含StartStr
参数：IncluR------是否包含OverStr
==================================================
FunctionGetBody(ConStr,StartStr,OverStr,IncluL,IncluR)
IfConStr=$False$orConStr=orIsNull(ConStr)=TrueOrStartStr=orIsNull(StartStr)=TrueOrOverStr=orIsNull(OverStr)=TrueThen
GetBody=$False$
ExitFunction
EndIf
DimConStrTemp
DimStart,Over
ConStrTemp=Lcase(ConStr)
StartStr=Lcase(StartStr)
OverStr=Lcase(OverStr)
Start=InStrB(1,ConStrTemp,StartStr,vbBinaryCompare)
response.writeStart&<br>&IncluL&<br>
response.end
IfStart<=0then
GetBody=$False$
ExitFunction
Else
IfIncluL=FalseThen
Start=Start+LenB(StartStr)
EndIf
EndIf
Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)
response.writeOver
response.end
response.writeStart&&Over&&Over-Start
response.end
IfOver<=0OrOver<=Startthen
GetBody=$False$
ExitFunction
Else
IfIncluR=TrueThen
Over=Over+LenB(OverStr)
EndIf
EndIf

GetBody=MidB(ConStr,Start,Over-Start)
response.writegetBody
response.end
EndFunction

==================================================
函数名：GetArray
作用：提取链接地址，以$Array$分隔
参数：ConStr------提取地址的原字符
参数：StartStr------开始字符串
参数：OverStr------结束字符串
参数：IncluL------是否包含StartStr
参数：IncluR------是否包含OverStr
==================================================
FunctionGetArray(ByvalConStr,StartStr,OverStr,IncluL,IncluR)
IfConStr=$False$orConStr=OrIsNull(ConStr)=TrueorStartStr=OrOverStr=orIsNull(StartStr)=TrueOrIsNull(OverStr)=TrueThen
GetArray=$False$
ExitFunction
EndIf
DimTempStr,TempStr2,objRegExp,Matches,Match
TempStr=
SetobjRegExp=NewRegexp
objRegExp.IgnoreCase=True
objRegExp.Global=True
objRegExp.Pattern=(&StartStr&).+?(&OverStr&)
SetMatches=objRegExp.Execute(ConStr)
ForEachMatchinMatches
TempStr=TempStr&$Array$&Match.Value
Next
SetMatches=nothing

IfTempStr=Then
GetArray=$False$
ExitFunction
EndIf
TempStr=Right(TempStr,Len(TempStr)-7)
IfIncluL=Falsethen
objRegExp.Pattern=StartStr
TempStr=objRegExp.Replace(TempStr,)
Endif
IfIncluR=Falsethen
objRegExp.Pattern=OverStr
TempStr=objRegExp.Replace(TempStr,)
Endif
SetobjRegExp=nothing
SetMatches=nothing

IfTempStr=then
GetArray=$False$
Else
GetArray=TempStr
Endif
EndFunction

FunctiongetAlexaRank(weburl)
tempurl=getDomainUrl(weburl)
读取中的数据
alexacss=
strAlexaCss=GetHttpPage(alexacss)
response.writestrAlexaCss
response.end
alexarankqueryurl=

strAlexaContent=GetHttpPage(alexarankqueryurl)

rankcontent=getBody(strAlexaContent,InformationService.-->,<!--google_ad_section_end(name=default)-->,false,false)
获取其中的span的class
strspan=GetArray(rankcontent,<spanclass=,,false,false)
response.writerankcontent&<br>
response.writestrspan&<br>
response.end
Ifstrspan<>$False$Then
aspan=split(strspan,$Array$)

Fori=0ToUBound(aspan)
response.write.&aspan(i)
判定aspan(i)即span的class是否在alexacss中存在，如果存在，则需要将这个span和span中的数据去掉。
IfInStr(strAlexaCss,.&aspan(i))>=1Then
response.writeaspan(i)&<br>
response.end
表示属性为none.需要替换掉。
rankcontent=ScriptHtml(rankcontent,span,2,aspan(i))
Else
rankcontent=ScriptHtml(rankcontent,span,1,aspan(i))
Endif
Next
替换上面少去掉的右边的span标签。
rankcontent=Replace(rankcontent,</span>,)


EndIf
Ifrankcontent=$False$Then
rankcontent=NoData
Endif
getAlexaRank=Replace(rankcontent,,,)

EndFunction
url=request.querystring(url)
%>

<formname=alexaformmethod=get>
输入网址:<inputtype=name=urlvalue=<%=url%>size=40><inputtype=submitvalue=查询>
</form>
<%
Ifurl<>Then

response.write您的网站在ALEXA的排名为：
response.flush
rank=getAlexaRank(url)
response.writerank
Endif
%>