asp alexa查询小偷程序_ASP教程-查字典教程网
asp alexa查询小偷程序
asp alexa查询小偷程序
发布时间:2016-12-29 来源:查字典编辑
摘要:

<%

'为了支持原创,请保留该处注释,谢谢!

'作者:草上飞

'获取主域名

FunctiongetDomainUrl(url)

tempurl=replace(url,"http://","")

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.open"GET",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)

'读取http://client.alexa.com/common/css/scramble.css中的数据

alexacss="http://client.alexa.com/common/css/scramble.css"

strAlexaCss=GetHttpPage(alexacss)

'response.writestrAlexaCss

'response.end

alexarankqueryurl="http://www.alexa.com/data/details/traffic_details/"&tempurl

strAlexaContent=GetHttpPage(alexarankqueryurl)

rankcontent=getBody(strAlexaContent,"InformationService.-->","<>",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="alexaform"method=get>

输入网址:<inputtype=""name="url"value="<%=url%>"size=40><inputtype="submit"value="查询">

</form>

<%

Ifurl<>""Then

response.write"您的网站在ALEXA的排名为:"

response.flush

rank=getAlexaRank(url)

response.writerank

Endif

%>

相关阅读
推荐文章
猜你喜欢
附近的人在看
推荐阅读
拓展阅读
  • 大家都在看
  • 小编推荐
  • 猜你喜欢
  • 最新ASP教程学习
    热门ASP教程学习
    编程开发子分类