Un programme de voleur Alexa relativement simple. Les amis qui aiment cette fonction peuvent apprendre ses principes. Je pense que vous pourrez bientôt écrire ce programme<%.
'Afin de favoriser l'originalité, merci de conserver ce commentaire, merci !
'Auteur : Fei Caoshang
'Obtenir le nom de domaine principal
Fonction getDomainUrl(url)
tempurl=replace(url,http://,)
si instr(tempurl,/)>0 alors
tempurl=gauche(tempurl,instr(tempurl,/)-1)
finSi
getDomainurl=tempurl
Fonction de fin
Fonction GetHttpPage(HttpUrl)
Si IsNull(HttpUrl)=True ou Len(HttpUrl)<18 ou HttpUrl=$False$ Alors
GetHttpPage=$False$
Fonction de sortie
Fin si
Faible Http
Définir Http=server.createobject(MSXML2.XMLHTTP)
Http.open GET,HttpUrl,False
Http.Envoyer()
Si Http.Readystate<>4 alors
Définir Http=Rien
GetHttpPage=$False$
Fonction de sortie
Terminer si
GetHTTPage=Http.responseText
Définir Http=Rien
Si NuméroErr.<>0 alors
Err.Effacer
Fin si
Fonction de fin
'================================================== = =
'Nom de la fonction : ScriptHtml
'Fonction : filtrer les balises html
'Paramètre : ConStr ------ La chaîne à filtrer
'TagName ------La balise à filtrer
' FType 1 signifie filtrer l'étiquette de gauche, 2 signifie filtrer les étiquettes gauche et droite et la valeur médiane 3 signifie filtrer l'étiquette gauche et l'étiquette droite, en conservant le contenu.
'================================================== = =
Fonction ScriptHtml(Byval ConStr,TagName,FType,includestr)
Dim Ré
Définir Re=new RegExp
Re.IgnoreCase=true
Re.Global=Vrai
Sélectionnez le type de cas F
Cas 1
Re.Pattern=< & TagName & ([^>])*(&includestr&){1,}([^>])*>
ConStr=Re.Replace(ConStr,)
Cas 2
Re.Pattern=< & TagName & ([^>])*(&includestr&){1,}([^>])*>.*?</ & TagName & ([^>])*>
'response.write construction&<br>
ConStr=Re.Replace(ConStr,)
'response.write serveur.htmlencode(constr)&<br>
Cas 3
Re.Pattern=< & TagName & ([^>])*(&includestr&){1,}([^>])*>
ConStr=Re.Replace(ConStr,)
Re.Pattern=</ & TagName & ([^>])*>
ConStr=Re.Replace(ConStr,)
Fin de la sélection
ScriptHtml=ConStr
Définir Re=Rien
Fonction de fin
'================================================== = =
'Nom de la fonction : GetBody
'Fonction : chaîne d'interception
'Paramètre : ConStr ------La chaîne à intercepter
'Paramètre : StartStr ------chaîne de démarrage
'Paramètre : OverStr ------Fin de chaîne
'Paramètre : IncluL ------Si StartStr est inclus
'Paramètre : IncluR ------s'il faut inclure OverStr
'================================================== = =
Fonction GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)
Si ConStr=$False$ ou ConStr= ou IsNull(ConStr)=True Ou StartStr= ou IsNull(StartStr)=True Ou OverStr= ou IsNull(OverStr)=True Alors
GetBody=$Faux$
Fonction de sortie
Fin si
DimConStrTemp
Dim Début, Fin
ConStrTemp=Lcase(ConStr)
StartStr=Lcase(StartStr)
SurStr=Lcase(SurStr)
Début = InStrB (1, ConStrTemp, StartStr, vbBinaryCompare)
'response.write Début&<br>&IncluL&<br>
'réponse.fin
Si Début <=0 alors
GetBody=$Faux$
Fonction de sortie
Autre
Si IncluL=False Alors
Début=Début+LenB(StartStr)
Fin si
Fin si
Over=InStrB(Démarrer,ConStrTemp,OverStr,vbBinaryCompare)
'response.write Over
'réponse.fin
'response.write Début& &Plus& &Plus-Démarrage
'réponse.fin
Si Over<=0 ou Over<=Start alors
GetBody=$Faux$
Fonction de sortie
Autre
Si InclR=Vrai Alors
Sur=Sur+LenB(SurStr)
Fin si
Fin si
GetBody = MidB (ConStr, Start, Over-Start)
'response.write getBody
'réponse.fin
Fonction de fin
'================================================== = =
'Nom de la fonction : GetArray
'Fonction : Extraire l'adresse du lien, séparée par $Array$
'Paramètre : ConStr ------Extraire les caractères originaux de l'adresse
'Paramètre : StartStr ------chaîne de démarrage
'Paramètre : OverStr ------Fin de chaîne
'Paramètre : IncluL ------Si StartStr est inclus
'Paramètre : IncluR ------s'il faut inclure OverStr
'================================================== = =
Fonction GetArray (Byval ConStr, StartStr, OverStr, IncluL, IncluR)
Si ConStr=$False$ ou ConStr= Ou IsNull(ConStr)=True ou StartStr= Ou OverStr= ou IsNull(StartStr)=True Ou IsNull(OverStr)=True Alors
GetArray=$Faux$
Fonction de sortie
Fin si
Dim TempStr, TempStr2, objRegExp, Correspondances, Correspondance
TempStr=
Définir objRegExp = Nouvelle expression rationnelle
objRegExp.IgnoreCase = True
objRegExp.Global = Vrai
objRegExp.Pattern = (&StartStr&).+?(&OverStr&)
Définir les correspondances =objRegExp.Execute(ConStr)
Pour chaque match dans les matchs
TempStr=TempStr & $Array$ & Match.Value
Suivant
Définir les correspondances = rien
Si TempStr= Alors
GetArray=$Faux$
Fonction de sortie
Fin si
TempStr=Droite(TempStr,Len(TempStr)-7)
Si IncluL=False alors
objRegExp.Pattern =StartStr
TempStr=objRegExp.Replace(TempStr,)
Terminer si
Si InclR=Faux alors
objRegExp.Pattern =OverStr
TempStr=objRegExp.Replace(TempStr,)
Terminer si
Définir objRegExp = rien
Définir les correspondances = rien
Si TempStr= alors
GetArray=$Faux$
Autre
GetArray=TempStr
Terminer si
Fonction de fin
Fonction getAlexaRank(weburl)
tempurl=getDomainUrl(weburl)
'Lisez les données dans http://client.alexa.com/common/css/scramble.css
alexacss=http://client.alexa.com/common/css/scramble.css
strAlexaCss=GetHttpPage(alexacss)
'response.write strAlexaCss
'réponse.fin
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)
'Obtenez la classe span
strspan=GetArray(rankcontent,<span class=,,false,false)
'response.write classement contenu&<br>
'response.write strspan&<br>
'réponse.fin
Si strspan<>$False$ Alors
aspan=split(strspan,$Array$)
Pour i = 0 vers UBound (aspan)
'réponse.écrire .&aspan(i)
'Déterminez si aspan(i), la classe du span, existe dans alexacss. Si elle existe, vous devez supprimer le span et les données qu'il contient.
Si InStr(strAlexaCss,.&aspan(i))>=1 Alors
'response.write aspan(i)&<br>
'réponse.fin
'Indique que l'attribut n'est aucun et doit être remplacé.
rangcontent=ScriptHtml(rankcontent,span,2,aspan(i))
Autre
rangcontent=ScriptHtml(rankcontent,span,1,aspan(i))
Terminer si
Suivant
'Remplacez la balise span à droite qui a été supprimée ci-dessus.
Rankcontent=Remplacer(rankcontent,</span>,)
Fin si
Si Rankcontent=$False$ Alors
Rankcontent=Aucune donnée
Terminer si
getAlexaRank=Remplacer(rankcontent,,,)
Fonction de fin
url=request.querystring(url)
%>
<nom du formulaire=méthode alexaform=get>
URL d'entrée :<input type= name=url value=<%=url%> size=40> <input type=submit value=query>
</form>
<%
Si url<> Alors
réponse.write Le classement ALEXA de votre site Web est :
réponse.flush
rang = getAlexaRank (url)
réponse.write rang
Terminer si
%>