Относительно простая воровская программа Alexa. Друзья, которым нравится эта функция, могут изучить ее принципы. Я думаю, вы скоро сможете написать эту программу<%.
«Чтобы поддержать оригинальность, пожалуйста, сохраните этот комментарий, спасибо!
Автор: Фэй Цаошан
'Получаем основное доменное имя
Функция getDomainUrl(url)
tempurl=replace(url,http://,)
если instr(tempurl,/)>0, то
tempurl=left(tempurl,instr(tempurl,/)-1)
конецЕсли
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.Отправить()
Если Http.Readystate<>4, то
Установить HTTP=Ничего
GetHttpPage=$False$
Функция выхода
Конец, если
GetHTTPage=Http.responseText
Установить HTTP=Ничего
Если номер ошибки<>0, то
Ошиб.Очистить
Конец, если
Конечная функция
'============================================== = =
'Имя функции: ScriptHtml
'Функция: фильтровать html-теги
'Параметр: ConStr ------ Строка, подлежащая фильтрации.
'TagName ------Тег для фильтрации.
' FType 1 означает фильтрацию левой метки, 2 означает фильтрацию левой и правой меток, а среднее значение 3 означает фильтрацию левой и правой меток с сохранением содержимого.
'============================================== = =
Функция ScriptHtml(Byval ConStr,TagName,FType,includestr)
Дим Ре
Установить Re=новое регулярное выражение
Re.IgnoreCase=истина
Re.Global=Истина
Выберите Case FType
Случай 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 server.htmlencode(constr)&<br>
Случай 3
Re.Pattern=< & TagName & ([^>])*(&includestr&){1,}([^>])*>
ConStr=Re.Replace(ConStr,)
Re.Pattern=</ & Имя тега & ([^>])*>
ConStr=Re.Replace(ConStr,)
Конец выбора
ScriptHtml=ConStr
Установить Re=Ничего
Конечная функция
'============================================== = =
'Имя функции: 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$
Выход из функции
Конец, если
ДимКонСтрТемп
Тусклый старт, окончено
ConStrTemp=Lcase(ConStr)
StartStr=Lcase(StartStr)
OverStr=Lcase(OverStr)
Start = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)
'response.write Start&<br>&IncluL&<br>
'ответ.конец
Если Начало<=0, то
GetBody=$False$
Выход из функции
Еще
Если IncluL=False Тогда
Старт=Старт+LenB(СтартСтр)
Конец, если
Конец, если
Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)
'response.write Over
'ответ.конец
'response.write Start& &Over& &Over-Start
'ответ.конец
Если Over<=0 или Over<=Start, то
GetBody=$False$
Выход из функции
Еще
Если InclR=True Тогда
Over=Over+LenB(OverStr)
Конец, если
Конец, если
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, совпадения, совпадение
ТемпСтр=
Установить objRegExp = Новое регулярное выражение
objRegExp.IgnoreCase = Истина
objRegExp.Global = Истина
objRegExp.Pattern = (&StartStr&).+?(&OverStr&)
Установить совпадения =objRegExp.Execute(ConStr)
За каждый матч в матчах
TempStr=TempStr & $Array$ & Match.Value
Следующий
Установить совпадения = ничего
Если ТемпСтр= Тогда
GetArray=$False$
Выход из функции
Конец, если
TempStr=Вправо(TempStr,Len(TempStr)-7)
Если IncluL=False, то
objRegExp.Pattern =НачСтр
TempStr=objRegExp.Replace(TempStr,)
Конец, если
Если InclR=False, то
objRegExp.Pattern =OverStr
TempStr=objRegExp.Replace(TempStr,)
Конец, если
Установить objRegExp=ничего
Установить совпадения = ничего
Если TempStr=, то
GetArray=$False$
Еще
GetArray=ТемпСтр
Конец, если
Конечная функция
Функция 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 Rankcontent&<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=Заменить(rankcontent,</span>,)
Конец, если
Если Rankcontent=$False$ Тогда
Rankcontent=Нет данных
Конец, если
getAlexaRank = Заменить (rankcontent,,,)
Конечная функция
URL = request.querystring (URL)
%>
<имя формы=метод alexaform=get>
Входной URL:<тип ввода= имя=значение URL=<%=url%> размер=40> <тип ввода=отправить значение=запрос>
</форма>
<%
Если URL<> Тогда
response.write Рейтинг вашего сайта по ALEXA:
ответ.flush
ранг = getAlexaRank (URL)
ответ.напишите рейтинг
Конец, если
%>