برنامج Alexa thief بسيط نسبيًا، يمكن للأصدقاء الذين يحبون هذه الوظيفة تعلم مبادئه، وأعتقد أنك ستتمكن من كتابة هذا البرنامج قريبًا<%.
'من أجل دعم الأصالة، يرجى الاحتفاظ بهذا التعليق، شكرًا لك!
"المؤلف: فاي كاوشانغ
'احصل على اسم المجال الرئيسي
الدالة getDomainUrl(url)
tempurl=replace(url,http://,)
إذا instr(tempurl,/)>0 ثم
tempurl=left(tempurl,instr(tempurl,/)-1)
endIf
getDomainurl=tempurl
وظيفة النهاية
الدالة GetHttpPage(HttpUrl)
إذا كان IsNull(HttpUrl)=True أو Len(HttpUrl)<18 أو HttpUrl=$False$ إذن
GetHttpPage=$False$
وظيفة الخروج
نهاية إذا
خافت المتشعب
تعيين Http=server.createobject(MSXML2.XMLHTTP)
Http.open الحصول على، HttpUrl، خطأ
المتشعب.إرسال ()
إذا Http.Readystate<>4 ثم
تعيين المتشعب = لا شيء
GetHttpPage=$False$
وظيفة الخروج
انتهي إذا
GetHTTPage=Http.responseText
تعيين المتشعب = لا شيء
إذا Err.number<>0 ثم
خطأ.واضح
نهاية إذا
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: ScriptHtml
'الوظيفة: تصفية علامات HTML
'المعلمة: ConStr ------ السلسلة المراد تصفيتها
'TagName ------العلامة المراد تصفيتها
'FType 1 يعني تصفية التسمية اليسرى، 2 يعني تصفية التسميات اليسرى واليمنى والقيمة الوسطى 3 تعني تصفية التسمية اليسرى والتسمية اليمنى، مع الاحتفاظ بالمحتوى.
'======================================================================== = =
الوظيفة ScriptHtml (Byval ConStr، TagName، FType، includestr)
ديم ري
تعيين إعادة = RegExp الجديد
Re.IgnoreCase=true
Re.Global = صحيح
حدد نوع الحالة
الحالة 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=</ & TagName & ([^>])*>
ConStr=Re.Replace(ConStr,)
إنهاء التحديد
ScriptHtml=ConStr
تعيين إعادة = لا شيء
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: 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)
ابدأ = InStrB(1، ConStrTemp، StartStr، vbBinaryCompare)
'response.write ابدأ&<br>&IncluL&<br>
"الاستجابة. نهاية."
إذا ابدأ<=0 ثم
GetBody=$False$
وظيفة الخروج
آخر
إذا كان IncluL=خطأ إذن
ابدأ=ابدأ+LenB(StartStr)
نهاية إذا
نهاية إذا
Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)
'الاستجابة.اكتب أكثر
"الاستجابة. نهاية."
'response.write Start&&Over&&Over-Start
"الاستجابة. نهاية."
إذا كان أكثر من <= 0 أو أكثر من <= ابدأ بعد ذلك
GetBody=$False$
وظيفة الخروج
آخر
إذا InclR = صحيح ثم
أكثر=أكثر+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، Matches، Match
TempStr=
تعيين objRegExp = New Regexp
objRegExp.IgnoreCase = صحيح
objRegExp.Global = صحيح
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 = خطأ إذن
objRegExp.Pattern =OverStr
TempStr=objRegExp.Replace(TempStr,)
انتهي إذا
اضبط objRegExp = لا شيء
تعيين التطابقات = لا شيء
إذا 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$ إذن
أسبان = سبليت (سترسبان، $ صفيف $)
بالنسبة إلى i=0 إلى UBound(aspan)
'response.write .&aspan(i)
"حدد ما إذا كانت فئة النطاق aspan(i) موجودة في alexacs. إذا كانت موجودة، فستحتاج إلى إزالة النطاق والبيانات الموجودة في النطاق."
إذا كان InStr(strAlexaCss,.&aspan(i))>=1 إذن
'response.write aspan(i)&<br>
"الاستجابة. نهاية."
'يشير إلى أن السمة لا شيء ويجب استبدالها.
rankcontent=ScriptHtml(rankcontent,span,2,aspan(i))
آخر
rankcontent=ScriptHtml(rankcontent,span,1,aspan(i))
انتهي إذا
التالي
"استبدل علامة الامتداد الموجودة على اليمين والتي تمت إزالتها أعلاه.
rankcontent=Replace(rankcontent,</span>,)
نهاية إذا
إذا كان محتوى الترتيب=$False$ إذن
rankcontent=لا توجد بيانات
انتهي إذا
getAlexaRank=Replace(rankcontent,,,)
وظيفة النهاية
url=request.querystring(url)
%>
<اسم النموذج = طريقة Alexaform = الحصول على>
عنوان URL للإدخال: <نوع الإدخال= الاسم=قيمة url=<%=url%> الحجم=40> <نوع الإدخال=قيمة الإرسال=الاستعلام>
</النموذج>
<%
إذا كان عنوان url<> إذن
Response.write تصنيف Alexa لموقع الويب الخاص بك هو:
استجابة. فلوش
رتبة = getAlexaRank(url)
استجابة.كتابة الرتبة
انتهي إذا
%>