โปรแกรมขโมย Alexa ที่ค่อนข้างเรียบง่าย เพื่อนๆ ที่ชอบฟังก์ชั่นนี้สามารถเรียนรู้หลักการของมันได้ ฉันเชื่อว่าคุณจะสามารถเขียนโปรแกรมนี้ได้เร็วๆ นี้<%
'เพื่อสนับสนุนความคิดริเริ่ม โปรดเก็บความคิดเห็นนี้ไว้ ขอบคุณ!
ผู้เขียน: เฟย เฉาซ่าง
'รับชื่อโดเมนหลัก
ฟังก์ชั่น getDomainUrl(url)
tempurl=แทนที่(url,http://,)
ถ้า instr(tempurl,/)>0 แล้ว
tempurl=ซ้าย(tempurl,instr(tempurl,/)-1)
สิ้นสุดถ้า
getDomainurl=tempurl
สิ้นสุดฟังก์ชัน
ฟังก์ชั่น GetHttpPage(HttpUrl)
ถ้า IsNull(HttpUrl)=True หรือ Len(HttpUrl)<18 หรือ HttpUrl=$False$ แล้ว
GetHttpPage=$False$
ออกจากฟังก์ชัน
สิ้นสุดถ้า
Dim Http
ตั้งค่า Http=server.createobject(MSXML2.XMLHTTP)
Http.open GET, HttpUrl, เท็จ
Http ส่ง()
ถ้า Http.Readystate<>4 แล้ว
ตั้ง Http=Nothing
GetHttpPage=$False$
ฟังก์ชั่นออก
จบถ้า
GetHTTPage=Http.responseText
ตั้ง Http=Nothing
ถ้า Err.number<>0 แล้ว
ผิดพลาด.เคลียร์
สิ้นสุดถ้า
สิ้นสุดฟังก์ชัน
'=================================================' ==
'ชื่อฟังก์ชัน: ScriptHtml
'ฟังก์ชัน: กรองแท็ก html'
'พารามิเตอร์: ConStr ------ สตริงที่จะกรอง
'TagName ------ แท็กที่ต้องการกรอง
' FType 1 หมายถึง การกรองป้ายกำกับด้านซ้าย 2 หมายถึง การกรองป้ายกำกับซ้ายและขวา และค่ากลาง 3 หมายถึง การกรองป้ายกำกับด้านซ้ายและป้ายกำกับด้านขวา โดยคงเนื้อหาไว้
'=================================================' ==
ฟังก์ชั่น ScriptHtml (Byval ConStr, TagName, FType, รวม str)
ดิม เร
ตั้งค่า Re=new RegExp
Re.IgnoreCase=จริง
Re.Global=จริง
เลือก ชนิด 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=</ & TagName & ([^>])*>
ConStr=Re.Replace(ConStr,)
สิ้นสุดการเลือก
ScriptHtml=ConStr
ตั้งค่า Re=Nothing
สิ้นสุดฟังก์ชัน
'=================================================' ==
'ชื่อฟังก์ชัน: GetBody
'ฟังก์ชัน: ตัดสตริง
'พารามิเตอร์: ConStr ------ สตริงที่จะดักจับ
'พารามิเตอร์: StartStr ------ สตริงเริ่มต้น
'พารามิเตอร์: OverStr ------ สตริงสิ้นสุด
'พารามิเตอร์: รวม ------ รวม StartStr หรือไม่
'พารามิเตอร์:IncluR ------จะรวม OverStr หรือไม่
'=================================================' ==
ฟังก์ชัน GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)
ถ้า ConStr=$False$ หรือ ConStr= หรือ IsNull(ConStr)=True หรือ StartStr= หรือ IsNull(StartStr)=True หรือ OverStr= หรือ IsNull(OverStr)=True แล้ว
GetBody=$เท็จ$
ออกจากฟังก์ชัน
สิ้นสุดถ้า
DimConStrTemp
เริ่มสลัว จบ
ConStrTemp=Lcase(ConStr)
StartStr=Lcase(StartStr)
OverStr=Lcase(OverStr)
เริ่มต้น = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)
'response.write เริ่ม&<br>&รวม&<br>
'response.end
ถ้าเริ่ม<=0แล้ว
GetBody=$เท็จ$
ออกจากฟังก์ชัน
อื่น
ถ้า IncluL=False แล้ว
เริ่มต้น=เริ่ม+LenB(StartStr)
สิ้นสุดถ้า
สิ้นสุดถ้า
เกิน = InStrB (เริ่ม, ConStrTemp, OverStr, vbBinary เปรียบเทียบ)
'response.write Over'
'response.end
'response.write เริ่มต้น& &เกิน& &เริ่มต้นมากเกินไป
'response.end
หากเกิน<=0 หรือมากกว่า<=เริ่มแล้ว
GetBody=$เท็จ$
ออกจากฟังก์ชัน
อื่น
ถ้า InclR=True แล้ว
เกิน=เกิน+LenB(OverStr)
สิ้นสุดถ้า
สิ้นสุดถ้า
GetBody=MidB(ConStr,สตาร์ท,โอเวอร์สตาร์ท)
'response.write getBody.'
'response.end
สิ้นสุดฟังก์ชัน
'=================================================' ==
'ชื่อฟังก์ชัน: GetArray
'ฟังก์ชัน: แยกที่อยู่ลิงก์ คั่นด้วย $Array$
'พารามิเตอร์: ConStr ------ แยกอักขระดั้งเดิมของที่อยู่
'พารามิเตอร์: StartStr ------ สตริงเริ่มต้น
'พารามิเตอร์: OverStr ------ สตริงสิ้นสุด
'พารามิเตอร์: รวม ------ รวม 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, แมตช์, แมตช์
TempStr=
ตั้งค่า objRegExp = Regexp ใหม่
objRegExp.IgnoreCase = จริง
objRegExp.Global = จริง
objRegExp.Pattern = (&StartStr&).+?(&OverStr&)
ตั้งค่าการจับคู่ =objRegExp.Execute(ConStr)
สำหรับการแข่งขันแต่ละครั้งในการแข่งขัน
TempStr=TempStr & $Array$ & Match.Value
ต่อไป
ตั้งค่าการจับคู่ = ไม่มีอะไรเลย
ถ้า TempStr= จากนั้น
GetArray=$False$
ออกจากฟังก์ชัน
สิ้นสุดถ้า
TempStr=ขวา(TempStr,เลน(TempStr)-7)
ถ้า IncluL=False แล้ว
objRegExp.Pattern =StartStr
TempStr=objRegExp.แทนที่(TempStr,)
จบถ้า
ถ้า InclR=False แล้ว
objRegExp.Pattern =OverStr
TempStr=objRegExp.แทนที่(TempStr,)
จบถ้า
ตั้งค่า objRegExp=nothing
ตั้งค่าการจับคู่ = ไม่มีอะไรเลย
ถ้า 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'
'response.end
alexarankqueryurl=http://www.alexa.com/data/details/traffic_details/&tempurl
strAlexaContent=GetHttpPage(alexarankqueryurl)
rankcontent=getBody(strAlexaContent,บริการข้อมูล.-->,<!-- google_ad_section_end(name=default) -->,false,false)
'รับคลาสสแปน
strspan=GetArray(อันดับเนื้อหา,<span class=,,false,false)
'response.write rankcontent&<br>
'response.write strspan&<br>
'response.end
ถ้า strspan<>$False$ แล้ว
aspan=split(strspan,$Array$)
สำหรับ i=0 ถึง UBound(aspan)
'response.write .&aspan(i)
'ตรวจสอบว่า aspan(i) ซึ่งเป็นคลาสของ span มีอยู่ใน alexacss หรือไม่ ถ้ามี คุณจะต้องลบ span และข้อมูลในช่วงนั้นออก
ถ้า InStr(strAlexaCss,.&aspan(i))>=1 จากนั้น
'response.write aspan(i)&<br>
'response.end
'บ่งชี้ว่าแอตทริบิวต์ไม่มีเลยและจำเป็นต้องเปลี่ยน
rankcontent=ScriptHtml(อันดับเนื้อหา,span,2,aspan(i))
อื่น
rankcontent=ScriptHtml(อันดับเนื้อหา,span,1,aspan(i))
จบถ้า
ต่อไป
'แทนที่แท็ก span ทางด้านขวาที่ถูกลบออกด้านบน
อันดับเนื้อหา=แทนที่(อันดับเนื้อหา</span>,)
สิ้นสุดถ้า
ถ้า rankcontent=$False$ แล้ว
rankcontent=ไม่มีข้อมูล
จบถ้า
getAlexaRank=แทนที่(เนื้อหาอันดับ ,,,)
สิ้นสุดฟังก์ชัน
url=request.querystring(url)
-
<ชื่อฟอร์ม=วิธี alexaform=get>
URL อินพุต:<input type= name=url value=<%=url%> size=40> <input type=submit value=query>
</แบบฟอร์ม>
-
ถ้า url<> แล้ว
response.write อันดับ ALEXA ของเว็บไซต์ของคุณคือ:
การตอบสนอง.ฟลัช
อันดับ = getAlexaRank (URL)
การตอบกลับเขียนอันดับ
จบถ้า
-