比較的単純な Alexa 泥棒プログラムです。この機能が気に入った友人は、すぐにこのプログラムを作成できるようになると思います。<%
「オリジナリティをサポートするために、このコメントは保存してください、ありがとう！」
著者：フェイ・カオシャン
'メインのドメイン名を取得します
関数 getDomainUrl(url)
tempurl=replace(url,http://,)
if instr(tempurl,/)>0 then
tempurl=left(tempurl,instr(tempurl,/)-1)
endIf
getDomainurl=tempurl
終了機能
関数 GetHttpPage(HttpUrl)
IsNull(HttpUrl)=True または Len(HttpUrl)<18 または HttpUrl=$False$ の場合
GetHttpPage=$False$
終了関数
終了の場合
薄暗いHTTP
Http=server.createobject(MSXML2.XMLHTTP) を設定します。
Http.open GET,HttpUrl,False
Http.Send()
Http.Readystate<>4 の場合、
Http=Nothing を設定します
GetHttpPage=$False$
終了機能
次の場合に終了
GetHTTPage=Http.responseText
Http=Nothing を設定します
Err.number<>0 の場合
エラークリア
終了の場合
終了機能
'================================================ = =
'関数名：ScriptHtml
'機能: HTMLタグをフィルターします
'パラメータ: ConStr ------ フィルタリングする文字列
'TagName -------フィルタリングするタグ
' FType 1 は左側のラベルをフィルタリングすることを意味し、2 は左側と右側のラベルをフィルタリングすることを意味し、中央の値 3 は左側のラベルと右側のラベルをフィルタリングしてコンテンツを保持することを意味します。
'================================================ = =
関数 ScriptHtml(Byval ConStr,TagName,FType,includestr)
ディム・レ
Re=新しい正規表現を設定
Re.IgnoreCase=true
Re.Global=True
ケースFタイプを選択してください
ケース1
Re.Pattern=< & TagName & ([^>])*(&includestr&){1,}([^>])*>
ConStr=Re.Replace(ConStr,)
ケース2
Re.Pattern=< & TagName & ([^>])*(&includestr&){1,}([^>])*>.*?</ & TagName & ([^>])*>
'response.write constr&<br>
ConStr=Re.Replace(ConStr,)
'response.write サーバー.htmlencode(constr)&<br>
ケース3
Re.Pattern=< & TagName & ([^>])*(&includestr&){1,}([^>])*>
ConStr=Re.Replace(ConStr,)
Re.Pattern=</ & タグ名 & ([^>])*>
ConStr=Re.Replace(ConStr,)
エンドセレクト
ScriptHtml=ConStr
Re=Nothing を設定する
終了機能
'================================================ = =
'関数名: GetBody
'関数: インターセプト文字列
'パラメータ: ConStr -------インターセプトされる文字列
'パラメータ: StartStr -------開始文字列
'パラメータ: OverStr -------終了文字列
'パラメータ: IncluL ------StartStr が含まれるかどうか
'パラメータ:IncluR -------OverStr を含めるかどうか
'================================================ = =
関数 GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)
ConStr=$False$ または ConStr= または IsNull(ConStr)=True または StartStr= または IsNull(StartStr)=True または OverStr= または IsNull(OverStr)=True の場合
GetBody=$False$
終了関数
終了の場合
DimConStrTemp
ディムスタート、オーバー
ConStrTemp=Lcase(ConStr)
StartStr=Lcase(StartStr)
OverStr=Lcase(OverStr)
Start = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)
'response.write 開始&<br>&IncluL&<br>
'応答.終了
開始<=0 の場合
GetBody=$False$
終了関数
それ以外
IncluL=False の場合
Start=Start+LenB(StartStr)
終了の場合
終了の場合
Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)
'response.write Over
'応答.終了
'response.write Start& &Over& &Over-Start
'応答.終了
オーバー<=0 またはオーバー<=スタートの場合
GetBody=$False$
終了関数
それ以外
InclR=True の場合
オーバー=オーバー+LenB(オーバーStr)
終了の場合
終了の場合
GetBody=MidB(ConStr,Start,Over-Start)
'response.write getBody
'応答.終了
終了機能
'================================================ = =
'関数名: GetArray
'機能: $Array$ で区切られたリンク アドレスを抽出します
'パラメータ: ConStr -------アドレスの元の文字を抽出します
'パラメータ: StartStr -------開始文字列
'パラメータ: OverStr -------終了文字列
'パラメータ: IncluL ------StartStr が含まれるかどうか
'パラメータ:IncluR -------OverStr を含めるかどうか
'================================================ = =
関数 GetArray(Byval ConStr,StartStr,OverStr,IncluL,IncluR)
ConStr=$False$ または ConStr= または IsNull(ConStr)=True または StartStr= または OverStr= または IsNull(StartStr)=True または IsNull(OverStr)=True の場合
GetArray=$False$
終了関数
終了の場合
Dim TempStr,TempStr2,objRegExp,Matches,Match
TempStr=
objRegExp = 新しい正規表現を設定します
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = (&StartStr&).+?(&OverStr&)
一致を設定 =objRegExp.Execute(ConStr)
試合中の各試合について
TempStr=TempStr & $Array$ & Match.Value
次
一致=なしを設定します
TempStr= の場合
GetArray=$False$
終了関数
終了の場合
TempStr=Right(TempStr,Len(TempStr)-7)
IncluL=False の場合
objRegExp.Pattern =StartStr
TempStr=objRegExp.Replace(TempStr,)
次の場合に終了
InclR=False の場合
objRegExp.Pattern =OverStr
TempStr=objRegExp.Replace(TempStr,)
次の場合に終了
objRegExp=nothing を設定します
一致=なしを設定します
TempStr= の場合
GetArray=$False$
それ以外
GetArray=TempStr
次の場合に終了
終了機能
関数 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
'応答.終了
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)
'スパンクラスを取得
strspan=GetArray(rankcontent,<span class=,,false,false)
'response.write ランクコンテンツ&<br>
'response.write strspan&<br>
'応答.終了
strspan<>$False$ の場合、次に
aspan=split(strspan,$Array$)
i=0 の場合 UBound(aspan) へ
'response.write .&aspan(i)
'スパンのクラスである aspan(i) が alexacss に存在するかどうかを確認します。存在する場合は、スパンとスパン内のデータを削除する必要があります。
InStr(strAlexaCss,.&aspan(i))>=1 の場合
'response.write aspan(i)&<br>
'応答.終了
' 属性が存在しないため、置換する必要があることを示します。
Rankcontent=ScriptHtml(rankcontent,span,2,aspan(i))
それ以外
Rankcontent=ScriptHtml(rankcontent,span,1,aspan(i))
次の場合に終了
次
' 上で削除した右側のspanタグを置き換えます。
Rankcontent=Replace(rankcontent,</span>,)
終了の場合
Rankcontent=$False$ の場合
ランクコンテンツ=データなし
次の場合に終了
getAlexaRank=Replace(rankcontent,,,)
終了機能
URL=リクエスト.クエリ文字列(URL)
%>
<フォーム名=alexaformメソッド=get>
入力 URL:<input type= name=url value=<%=url%> size=40> <input type=submit value=query>
</form>
<%
If URL<> then
response.write あなたのウェブサイトの ALEXA ランキングは次のとおりです。
応答.フラッシュ
ランク=getAlexaRank(url)
応答.書き込みランク
次の場合に終了
%>