Ein relativ einfaches Alexa-Diebprogramm. Freunde, die diese Funktion mögen, können die Prinzipien lernen. Ich glaube, Sie werden dieses Programm bald schreiben können.
„Um die Originalität zu unterstützen, behalten Sie diesen Kommentar bitte bei, vielen Dank!“
'Autor: Fei Caoshang
'Holen Sie sich den Hauptdomänennamen
Funktion getDomainUrl(url)
tempurl=replace(url,http://,)
wenn instr(tempurl,/)>0 dann
tempurl=left(tempurl,instr(tempurl,/)-1)
endIf
getDomainurl=tempurl
Funktion beenden
Funktion GetHttpPage(HttpUrl)
Wenn IsNull(HttpUrl)=True oder Len(HttpUrl)<18 oder HttpUrl=$False$, dann
GetHttpPage=$False$
Exit-Funktion
Ende wenn
Http dimmen
Legen Sie Http=server.createobject(MSXML2.XMLHTTP) fest.
Http.open GET,HttpUrl,False
Http.Send()
Wenn Http.Readystate<>4 dann
Setzen Sie Http=Nothing
GetHttpPage=$False$
Exit-Funktion
Beenden Sie, wenn
GetHTTPage=Http.responseText
Setzen Sie Http=Nothing
Wenn Err.number<>0 dann
Fehler.Klar
Ende wenn
Funktion beenden
'============================================== = =
'Funktionsname: ScriptHtml
'Funktion: HTML-Tags filtern
'Parameter: ConStr ------ Die zu filternde Zeichenfolge
'TagName ------Das zu filternde Tag
' FType 1 bedeutet Filterung des linken Etiketts, 2 bedeutet Filterung des linken und rechten Etiketts und der mittlere Wert 3 bedeutet Filterung des linken und rechten Etiketts unter Beibehaltung des Inhalts.
'============================================== = =
Funktion ScriptHtml(Byval ConStr,TagName,FType,includestr)
Dim Re
Setzen Sie Re=new RegExp
Re.IgnoreCase=true
Re.Global=True
Wählen Sie Fall-FType aus
Fall 1
Re.Pattern=< & TagName & ([^>])*(&includestr&){1,}([^>])*>
ConStr=Re.Replace(ConStr,)
Fall 2
Re.Pattern=< & TagName & ([^>])*(&includestr&){1,}([^>])*>.*?</ & TagName & ([^>])*>
'response.write constr&<br>
ConStr=Re.Replace(ConStr,)
'response.write server.htmlencode(constr)&<br>
Fall 3
Re.Pattern=< & TagName & ([^>])*(&includestr&){1,}([^>])*>
ConStr=Re.Replace(ConStr,)
Re.Pattern=</ & TagName & ([^>])*>
ConStr=Re.Replace(ConStr,)
Endauswahl
ScriptHtml=ConStr
Setze Re=Nothing
Funktion beenden
'============================================== = =
'Funktionsname: GetBody
'Funktion: Zeichenfolge abfangen
'Parameter: ConStr ------Die abzufangende Zeichenfolge
'Parameter: StartStr ------Startzeichenfolge
'Parameter: OverStr ------Endstring
'Parameter: IncluL ------Ob StartStr enthalten ist
'Parameter:IncluR ------ob OverStr eingeschlossen werden soll
'============================================== = =
Funktion GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)
Wenn ConStr=$False$ oder ConStr= oder IsNull(ConStr)=True oder StartStr= oder IsNull(StartStr)=True oder OverStr= oder IsNull(OverStr)=True, dann
GetBody=$False$
Exit-Funktion
Ende wenn
DimConStrTemp
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
Wenn Start<=0 dann
GetBody=$False$
Exit-Funktion
Anders
Wenn IncluL=False, dann
Start=Start+LenB(StartStr)
Ende wenn
Ende wenn
Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)
'response.write Over
'response.end
'response.write Start& &Over& &Over-Start
'response.end
Wenn Over<=0 oder Over<=Start dann
GetBody=$False$
Exit-Funktion
Anders
Wenn InclR=True, dann
Over=Over+LenB(OverStr)
Ende wenn
Ende wenn
GetBody=MidB(ConStr,Start,Over-Start)
'response.write getBody
'response.end
Funktion beenden
'============================================== = =
'Funktionsname: GetArray
'Funktion: Extrahieren Sie die Linkadresse, getrennt durch $Array$
'Parameter: ConStr ------Extrahieren Sie die Originalzeichen der Adresse
'Parameter: StartStr ------Startzeichenfolge
'Parameter: OverStr ------Endstring
'Parameter: IncluL ------Ob StartStr enthalten ist
'Parameter:IncluR ------ob OverStr eingeschlossen werden soll
'============================================== = =
Funktion GetArray(Byval ConStr,StartStr,OverStr,IncluL,IncluR)
Wenn ConStr=$False$ oder ConStr= oder IsNull(ConStr)=True oder StartStr= oder OverStr= oder IsNull(StartStr)=True oder IsNull(OverStr)=True, dann
GetArray=$False$
Exit-Funktion
Ende wenn
Dimmen Sie TempStr,TempStr2,objRegExp,Matches,Match
TempStr=
Setze objRegExp = Neuer Regexp
objRegExp.IgnoreCase = True
objRegExp.Global = True
objRegExp.Pattern = (&StartStr&).+?(&OverStr&)
Übereinstimmungen festlegen =objRegExp.Execute(ConStr)
Für jedes Spiel in Spielen
TempStr=TempStr & $Array$ & Match.Value
Nächste
Setze Übereinstimmungen=nichts
Wenn TempStr= Dann
GetArray=$False$
Exit-Funktion
Ende wenn
TempStr=Right(TempStr,Len(TempStr)-7)
Wenn IncluL=False, dann
objRegExp.Pattern =StartStr
TempStr=objRegExp.Replace(TempStr,)
Beenden Sie, wenn
Wenn InclR=False, dann
objRegExp.Pattern =OverStr
TempStr=objRegExp.Replace(TempStr,)
Beenden Sie, wenn
Setze objRegExp=nothing
Setze Übereinstimmungen=nichts
Wenn TempStr= dann
GetArray=$False$
Anders
GetArray=TempStr
Beenden Sie, wenn
Funktion beenden
Funktion getAlexaRank(weburl)
tempurl=getDomainUrl(weburl)
'Lesen Sie die Daten in 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)
'Holen Sie sich die Span-Klasse
strspan=GetArray(rankcontent,<span class=,,false,false)
'response.write rankcontent&<br>
'response.write strspan&<br>
'response.end
Wenn strspan<>$False$ Dann
aspan=split(strspan,$Array$)
Für i=0 bis UBound(aspan)
'response.write .&aspan(i)
'Bestimmen Sie, ob aspan(i), die Klasse des Spans, in alexacss vorhanden ist. Wenn sie existiert, müssen Sie den Span und die Daten im Span entfernen.
Wenn InStr(strAlexaCss,.&aspan(i))>=1 Dann
'response.write aspan(i)&<br>
'response.end
'Zeigt an, dass das Attribut keins ist und ersetzt werden muss.
rankcontent=ScriptHtml(rankcontent,span,2,aspan(i))
Anders
rankcontent=ScriptHtml(rankcontent,span,1,aspan(i))
Beenden Sie, wenn
Nächste
„Ersetzen Sie das Span-Tag auf der rechten Seite, das oben entfernt wurde.“
rankcontent=Replace(rankcontent,</span>,)
Ende wenn
Wenn rankcontent=$False$ Dann
rankcontent=Keine Daten
Beenden Sie, wenn
getAlexaRank=Replace(rankcontent,,,)
Funktion beenden
url=request.querystring(url)
%>
<form name=alexaform method=get>
Eingabe-URL:<Eingabetyp=Name=URL-Wert=<%=URL%> Größe=40> <Eingabetyp=Submit-Wert=Abfrage>
</form>
<%
Wenn URL<> Dann
Response.write Das ALEXA-Ranking Ihrer Website lautet:
Antwort.Flush
rank=getAlexaRank(url)
Antwort.Write-Rang
Beenden Sie, wenn
%>