Un programa ladrón de Alexa relativamente simple. Los amigos a quienes les guste esta función pueden aprender sus principios. Creo que pronto podrán escribir este programa <%.
'Para apoyar la originalidad, por favor conserve este comentario, ¡gracias!
'Autor: Fei Caoshang
'Obtener el nombre de dominio principal
Función getDomainUrl(url)
tempurl=reemplazar(url,http://,)
si instr(tempurl,/)>0 entonces
tempurl=izquierda(tempurl,instr(tempurl,/)-1)
final si
getDomainurl=tempurl
Función final
Función ObtenerHttpPage(HttpUrl)
Si IsNull(HttpUrl)=True O Len(HttpUrl)<18 O HttpUrl=$False$ Entonces
GetHttpPage=$Falso$
Función de salida
Terminar si
HTTP tenue
Establecer Http=servidor.createobject(MSXML2.XMLHTTP)
Http.open OBTENER, HttpUrl, Falso
Http.Enviar()
Si Http.Readystate<>4 entonces
Establecer Http=Nada
GetHttpPage=$Falso$
Función de salida
terminar si
GetHTTPage=Http.responseText
Establecer Http=Nada
Si Número de error<>0 entonces
Err.Borrar
Terminar si
Función final
'=================================================== = =
'Nombre de la función: ScriptHtml
'Función: filtrar etiquetas html
'Parámetro: ConStr ------ La cadena a filtrar
'TagName ------La etiqueta que se filtrará
' FType 1 significa filtrar la etiqueta izquierda, 2 significa filtrar las etiquetas izquierda y derecha y el valor medio 3 significa filtrar la etiqueta izquierda y la etiqueta derecha, conservando el contenido.
'=================================================== = =
Función ScriptHtml (Byval ConStr, TagName, FType, includestr)
Re tenue
Establecer Re = nueva RegExp
Re.IgnoreCase=verdadero
Re.Global=Verdadero
Seleccione el tipo de caso F
Caso 1
Re.Pattern=< & Nombre de etiqueta & ([^>])*(&includestr&){1,}([^>])*>
ConStr=Re.Reemplazar(ConStr,)
Caso 2
Re.Pattern=< & Nombre de etiqueta & ([^>])*(&includestr&){1,}([^>])*>.*?</ & Nombre de etiqueta & ([^>])*>
'respuesta.escribir constr&<br>
ConStr=Re.Reemplazar(ConStr,)
'respuesta.escribir servidor.htmlencode(constr)&<br>
Caso 3
Re.Pattern=< & Nombre de etiqueta & ([^>])*(&includestr&){1,}([^>])*>
ConStr=Re.Reemplazar(ConStr,)
Re.Pattern=</ & Nombre de etiqueta & ([^>])*>
ConStr=Re.Reemplazar(ConStr,)
Seleccionar fin
ScriptHtml=ConStr
Establecer Re=Nada
Función final
'=================================================== = =
'Nombre de la función: GetBody
'Función: interceptar cadena
'Parámetro: ConStr ------La cadena que se va a interceptar
'Parámetro: StartStr ------cadena de inicio
'Parámetro: OverStr ------Fin de cadena
'Parámetro: IncluL ------Si StartStr está incluido
'Parámetro:IncluR ------si se incluye OverStr
'=================================================== = =
Función GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)
Si ConStr=$False$ o ConStr= o IsNull(ConStr)=True O StartStr= o IsNull(StartStr)=True O OverStr= o IsNull(OverStr)=True Entonces
ObtenerCuerpo=$Falso$
Función de salida
Terminar si
DimConStrTemp
Inicio oscuro, finalizado
ConStrTemp=Lcase(ConStr)
StartStr=Lcase(InicioStr)
SobreStr=Lcase(SobreStr)
Inicio = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)
'response.write Inicio&<br>&IncluL&<br>
'respuesta.end
Si Inicio<=0 entonces
ObtenerCuerpo=$Falso$
Función de salida
Demás
Si IncluL=False entonces
Inicio=Inicio+LenB(InicioStr)
Terminar si
Terminar si
Over=InStrB(Inicio,ConStrTemp,OverStr,vbBinaryCompare)
'respuesta.escribir sobre
'respuesta.end
'response.write Inicio& &Over& &Over-Inicio
'respuesta.end
Si Over<=0 o Over<=Iniciar entonces
ObtenerCuerpo=$Falso$
Función de salida
Demás
Si InclR = Verdadero entonces
Sobre=Sobre+LenB(SobreStr)
Terminar si
Terminar si
GetBody=MidB(ConStr,Inicio,Sobreinicio)
'respuesta.escribir getBody
'respuesta.end
Función final
'=================================================== = =
'Nombre de la función: GetArray
'Función: Extrae la dirección del enlace, separada por $Array$
'Parámetro: ConStr ------Extrae los caracteres originales de la dirección
'Parámetro: StartStr ------cadena de inicio
'Parámetro: OverStr ------Fin de cadena
'Parámetro: IncluL ------Si StartStr está incluido
'Parámetro:IncluR ------si se incluye OverStr
'=================================================== = =
Función GetArray(Byval ConStr,StartStr,OverStr,IncluL,IncluR)
Si ConStr=$False$ o ConStr= O IsNull(ConStr)=True o StartStr= O OverStr= o IsNull(StartStr)=True O IsNull(OverStr)=True Entonces
ObtenerArray=$Falso$
Función de salida
Terminar si
Dim TempStr, TempStr2, objRegExp, Coincidencias, Coincidencia
TempStr=
Establecer objRegExp = Nueva expresión regular
objRegExp.IgnoreCase = Verdadero
objRegExp.Global = Verdadero
objRegExp.Pattern = (&StartStr&).+?(&OverStr&)
Establecer coincidencias =objRegExp.Execute(ConStr)
Para cada partido en partidos
TempStr=TempStr & $Array$ & Coincidencia.Valor
Próximo
Establecer coincidencias = nada
Si TempStr = Entonces
ObtenerArray=$Falso$
Función de salida
Terminar si
TempStr=Derecha(TempStr,Len(TempStr)-7)
Si IncluL=False entonces
objRegExp.Pattern =StartStr
TempStr=objRegExp.Replace(TempStr,)
terminar si
Si InclR = Falso entonces
objRegExp.Pattern =OverStr
TempStr=objRegExp.Replace(TempStr,)
terminar si
Establecer objRegExp=nada
Establecer coincidencias = nada
Si TempStr= entonces
ObtenerArray=$Falso$
Demás
GetArray=TempStr
terminar si
Función final
Función obtenerAlexaRank(weburl)
tempurl=obtenerUrlDominio(weburl)
'Lea los datos en http://client.alexa.com/common/css/scramble.css
alexacss=http://client.alexa.com/common/css/scramble.css
strAlexaCss=GetHttpPage(alexacss)
'respuesta.escribir strAlexaCss
'respuesta.end
alexarankqueryurl=http://www.alexa.com/data/details/traffic_details/&tempurl
strAlexaContent=GetHttpPage(alexarankqueryurl)
rankcontent=getBody(strAlexaContent,Servicio de información.-->,<!-- google_ad_section_end(nombre=predeterminado) -->,false,false)
'Obtén la clase abarcada
strspan=GetArray(rankcontent,<span class=,,false,false)
'respuesta.escribir contenido clasificado&<br>
'respuesta.escribir strspan&<br>
'respuesta.end
Si strspan<>$False$ Entonces
aspan=dividir(strspan,$matriz$)
Para i=0 a UBound(aspan)
'respuesta.escribir .&aspan(i)
'Determine si aspan(i), la clase del intervalo, existe en alexacss. Si existe, debe eliminar el intervalo y los datos del intervalo.
Si InStr(strAlexaCss,.&aspan(i))>=1 Entonces
'respuesta.escribir aspan(i)&<br>
'respuesta.end
'Indica que el atributo no es ninguno y necesita ser reemplazado.
contenidorango=ScriptHtml(contenidorango,span,2,aspan(i))
Demás
contenidorango=ScriptHtml(contenidorango,span,1,aspan(i))
terminar si
Próximo
'Reemplace la etiqueta de intervalo a la derecha que se eliminó arriba.
rankingcontent=Reemplazar(rankcontent,</span>,)
Terminar si
Si rankingcontent=$False$ Entonces
rankingcontent=Sin datos
terminar si
getAlexaRank=Reemplazar(clasificar contenido,,,)
Función final
url=solicitud.cadena de consulta(url)
%>
<nombre del formulario=método alexaform=obtener>
URL de entrada:<tipo de entrada= nombre=valor de URL=<%=url%> tamaño=40> <tipo de entrada=valor de envío=consulta>
</formulario>
<%
Si URL<> Entonces
Response.write El ranking ALEXA de su sitio web es:
respuesta.flush
rango=obtenerAlexaRank(url)
rango de respuesta.escritura
terminar si
%>