asp alexa查询小偷程序
日期:2021-09-05 22:08:22 来源:脚本之家
'为了支持原创,请保留该处注释,谢谢!
'作者:草上飞
'获取主域名
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
%>
您感兴趣的教程
在docker中安装mysql详解
本篇文章主要介绍了在docker中安装mysql详解,小编觉得挺不错的,现在分享给大家,也给大家做个参考。一起跟随小编...
win10中文输入法仅在桌面显示怎么办?
win10系统使用搜狗,QQ输入法只有在显示桌面的时候才出来,在使用其他程序输入框里面却只能输入字母数字,win10中...
一分钟掌握linux系统目录结构
这篇文章主要介绍了linux系统目录结构,通过结构图和多张表格了解linux系统目录结构,感兴趣的小伙伴们可以参考一...
PHP程序员玩转Linux系列 Linux和Windows安装
这篇文章主要为大家详细介绍了PHP程序员玩转Linux系列文章,Linux和Windows安装nginx教程,具有一定的参考价值,感兴趣...
win10怎么安装杜比音效Doby V4.1 win10安装杜
第四代杜比®家庭影院®技术包含了一整套协同工作的技术,让PC 发出清晰的环绕声同时第四代杜比家庭影院技术...
纯CSS实现iOS风格打开关闭选择框功能
这篇文章主要介绍了纯CSS实现iOS风格打开关闭选择框,本文通过实例代码给大家介绍的非常详细,对大家的学习或工作...
Win7如何给C盘扩容 Win7系统电脑C盘扩容的
Win7给电脑C盘扩容的办法大家知道吗?当系统分区C盘空间不足时,就需要给它扩容了,如果不管,C盘没有足够的空间...
百度推广竞品词的投放策略
SEM是基于关键词搜索的营销活动。作为推广人员,我们所做的工作,就是打理成千上万的关键词,关注它们的质量度...
Visual Studio Code(vscode) git的使用教程
这篇文章主要介绍了详解Visual Studio Code(vscode) git的使用,小编觉得挺不错的,现在分享给大家,也给大家做个参考。...
七牛云储存创始人分享七牛的创立故事与
这篇文章主要介绍了七牛云储存创始人分享七牛的创立故事与对Go语言的应用,七牛选用Go语言这门新兴的编程语言进行...
Win10预览版Mobile 10547即将发布 9月19日上午
微软副总裁Gabriel Aul的Twitter透露了 Win10 Mobile预览版10536即将发布,他表示该版本已进入内部慢速版阶段,发布时间目...
HTML标签meta总结,HTML5 head meta 属性整理
移动前端开发中添加一些webkit专属的HTML5头部标签,帮助浏览器更好解析HTML代码,更好地将移动web前端页面表现出来...
移动端html5模拟长按事件的实现方法
这篇文章主要介绍了移动端html5模拟长按事件的实现方法的相关资料,小编觉得挺不错的,现在分享给大家,也给大家...
HTML常用meta大全(推荐)
这篇文章主要介绍了HTML常用meta大全(推荐),文中通过示例代码介绍的非常详细,对大家的学习或者工作具有一定的参...
cdr怎么把图片转换成位图? cdr图片转换为
cdr怎么把图片转换成位图?cdr中插入的图片想要转换成位图,该怎么转换呢?下面我们就来看看cdr图片转换为位图的...
win10系统怎么录屏?win10系统自带录屏详细
当我们是使用win10系统的时候,想要录制电脑上的画面,这时候有人会想到下个第三方软件,其实可以用电脑上的自带...