หลังจากเรียนเป็นเวลาสองวันฉันสร้างรหัสต่อไปนี้และแบ่งปันกับเพื่อนร่วมงานแต่ละคน การคลานข้อมูลไม่ถูกต้อง
ตั้งค่า r = server.createObject (microsoft.xmlhttp)
r.open get, url, false,
R.SetRequestheader referier, URL
อาร์เซนด์
str1 = b2s (responsebody)
str1 = แทนที่ (str1 ,,,)
ตั้งค่า reg = ใหม่ regexp
reg.multiline = true
reg.global = true
reg.ignorecase = true
str_top = <font color =#fb5e3c>
str_bottom = </font>
reg.pattern = & str_top & (. |/n)*?) & str_bottom &
Set Matches = reg.execute (str1)
str1 =
สำหรับแต่ละ match1 ในการแข่งขัน
str1 = match1.value
ต่อไป
ตั้งค่าการจับคู่ = ไม่มีอะไร
ตั้งค่า reg = ไม่มีอะไร
str1 = แทนที่ (แทนที่ (str1, str_top,), str_bottom,)
conn.execute (อัปเดต set webtable pr = '& str1 &' โดยที่ id = & id)
สิ้นสุดย่อย
ข้อผิดพลาดย่อย (str) เลือก case str
กรณีที่ 1
response.write <br> & nbsp; & nbsp; เครื่องมือค้นหาว่างเปล่ากรุณาติดต่อ <a href = mailto: [email protected]> [email protected] </a>
กรณีที่ 2
Response.write <br> & nbsp; & nbsp; ชื่อไซต์ว่างเปล่ากรุณาติดต่อ <a href = mailto: [email protected]> [email protected] </a>
กรณีที่ 3
Response.write <br> & nbsp; & nbsp; เครื่องมือค้นหาที่คุณป้อนไม่ได้รับการสนับสนุนโดยโปรแกรมนี้โปรดติดต่อ <a href = mailto: [email protected]> [email protected] </a> /html>
กรณีที่ 4
response.write <br> & nbsp; & nbsp; ข้อผิดพลาดที่ไม่รู้จัก - ข้อมูลไม่สามารถรวบรวมข้อมูลได้โปรด <font color = blue> <a href = javaScript: location.reload ();> รีเฟรช </a> </font> ลองอีกครั้ง < /body> </html>
สิ้นสุดเลือก
Response.end
end subsub Google (strurl, id, all) url = http: //www.google.cn/search? สมบูรณ์ = 1 & hl = zh-cn & q = ไซต์%3a & strurl && meta =
str = gethttppage (url)
ถ้า str = จากนั้น
conn.execute (อัปเดต set webtable google = '0' โดยที่ id = & id)
อื่น
ตั้งค่า reg = ใหม่ regexp
reg.multiline = true
reg.global = false
reg.ignorecase = true
str_top = <td align = ขวา nowrap> <font size = -1>
str_bottom = </font> </td> </tr> </table>
reg.pattern = & str_top & ((.)*) & str_bottom &
ตั้งค่าการจับคู่ = reg.execute (str)
สำหรับแต่ละ match1 ในการแข่งขัน
str = match1.value
ต่อไป
ตั้งค่าการจับคู่ = ไม่มีอะไร
ถ้า instr (str, <html>) = 1 แล้ว
str2 = 0
อื่น
str = split (str, </b>)
str1 = str (3)
str2 = split (str1, <b>) (1)
สิ้นสุดถ้า
ถ้า str2 = หรือ len (str2)> 200 แล้ว
conn.execute (อัปเดต set webtable google = '0' โดยที่ id = & id)
อื่น
conn.execute (อัปเดตชุด webtable google = '& str2 &' โดยที่ id = & id)
สิ้นสุดถ้า
สิ้นสุดถ้า
สิ้นสุด subsub baidu (str, id, all) 'call print_do (baidu) ถ้าทั้งหมด = n แล้ว
url = http: //www.baidu.com/s? wd = site%3a & str && cl = 3
อื่น
strext = split (str,.)
url = http: //www.baidu.com/s? wd = & strext (0) && cl = 3
สิ้นสุดถ้า
'response.write (<br> url ของ Baidu: & url) ถ้า isobjinstalled (asphttp.conn) = จริงแล้ว
str = getasphttppage (url)
อื่น
str = gethttppage (url)
สิ้นสุดถ้า
ถ้า str = จากนั้น
ข้อผิดพลาดการโทร (4)
อื่น
ตั้งค่า reg = ใหม่ regexp
reg.multiline = true
reg.global = false
reg.ignorecase = true
str_top = <td align = ขวา nowrap>
str_bottom = </td>
reg.pattern = & str_top & (. |/n)*?) & str_bottom &
ตั้งค่าการจับคู่ = reg.execute (str)
สำหรับแต่ละ match1 ในการแข่งขัน
str = match1.value
ต่อไป
ตั้งค่าการจับคู่ = ไม่มีอะไร
ตั้งค่า reg = nothingResponse.write <br>
'response.write & nbsp; & nbsp;
ถ้า str = หรือ len (str)> 200 แล้ว
conn.execute (อัปเดต webtable set baidu = '0' โดยที่ id = & id)
อื่น
ถ้า instr (str, ประมาณ) = 0 แล้ว
keyw = หน้า
อื่น
keyw = โดยประมาณ
สิ้นสุดถ้า
str = mid (str, (str (str, keyw) +1), (str (str, บทความ) -instr (str, keyw) -1))
Response.Write Str
conn.execute (อัปเดต set webtable set baidu = '& แทนที่ (แทนที่ (str ,,,,) ,,) &' โดยที่ id = & id)
สิ้นสุดถ้า
สิ้นสุดถ้า
end subsub Alexa (strurl, id)
url = http: //www.alexa.com/data/details/traffic_details? q = & url = & strurl
ตั้งค่า r = server.createObject (microsoft.xmlhttp)
r.open get, url, false,
R.SetRequestheader referier, URL
อาร์เซนด์
str1 = bytes2bstr (r.responsebody)
str1 = แทนที่ (str1 ,,,)
ตั้งค่า reg = ใหม่ regexp
reg.multiline = true
reg.global = true
reg.ignorecase = true
str_top = <!-คุณรู้หรือไม่
str_bottom = </span> <br>
reg.pattern = & str_top & (. |/n)*?) & str_bottom &
Set Matches = reg.execute (str1)
str1 =
สำหรับแต่ละ match1 ในการแข่งขัน
str1 = str1 & match1.value
ต่อไป
ตั้งค่าการจับคู่ = ไม่มีอะไร
ตั้งค่า reg = ไม่มีอะไร
str1 = แทนที่ (str1, <!-คุณรู้หรือไม่? Alexa เสนอข้อมูลนี้โดยทางโปรแกรมเยี่ยมชม http://aws.amazon.com/awis สำหรับข้อมูลเพิ่มเติมเกี่ยวกับบริการข้อมูลเว็บ Alexa
ถ้า str1 <> แล้ว
str1 = แทนที่ (str1, <span class,)
str1 = แทนที่ (str1, </span> </span>,)
str1 = แทนที่ (str1 ,,)
str1 = แทนที่ (str1 ,,)
str1 = split (str1, <br>) (0)
ถ้า CSTR (ขวา (str1,7)) = </span> จากนั้น
str1 = ซ้าย (trim (str1), len (str1) -7)
สิ้นสุดถ้า
ถ้า isnumeric (str1) แล้ว
num = str1
อื่น
csstxt = getalexacss ()
num =
str1 = split (str1, </span>)
สำหรับ i = 0 ถึง Ubund (str1)
str2 = str1 (i)
ถ้าเหลือ (str2, instr (str2, =)) <> แล้ว
num = num & left (str2, instr (str2, =)-1)
str2 = ขวา (str2, len (str2) -instr (str2, =))
สิ้นสุดถ้า
str3 = split (str2,>)
สำหรับ j = 0 ถึง ubund (str3)
ต่อไป
ถ้า str3 (0) <> จากนั้น
ถ้าไม่ใช่ isnumeric (str3 (0)) แล้ว
ถ้า instr (csstxt, str3 (0)) = 0 แล้ว
num = num & str3 (1)
สิ้นสุดถ้า
สิ้นสุดถ้า
สิ้นสุดถ้า
ต่อไป
สิ้นสุดถ้า
อื่น
num = 0
สิ้นสุดถ้า
sql = อัปเดต webtable set alexa = '& num &' โดยที่ id = & id
Response.write (<script> Alert ('& sql &') </script>)
conn.execute (SQL)
สิ้นสุดฟังก์ชั่นย่อย B2S (STR)
หรี่
SET O = Server.CreateObject (ADODB.Stream)
O.Type = 1
O.Mode = 3
O.Open
o.write str
O.Position = 0
O.Type = 2
O.Charset = GB2312
B2S = O.ReadText
O.Close
ตั้งค่า o = ไม่มีอะไร
ฟังก์ชันสิ้นสุด 'รับสไตล์ของ Alexa
ฟังก์ชั่น getalexacss ()
url = http: //client.alexa.com/common/css/scramble.css
ถ้า isobjinstalled (asphttp.conn) = true แล้ว
str = getasphttppage (url)
อื่น
str = gethttppage (url)
สิ้นสุดถ้า
getAlexacss = str
End FunctionSub Print_do (STR)
Response.write <Script>
response.write ฟังก์ชั่น hiddenload ()
Response.write {
Response.write parent.do & Style.style.display = 'none';
Response.write}
Response.write </script>
Response.write <body leftmargin = 0 topmargin = 0 marginWidth = 0 marginHeight = 0 bgcolor =#f2f2f2 onload = hiddenload ()>>
สิ้นสุดฟังก์ชั่นย่อย gethttppage (URL)
เมื่อเกิดข้อผิดพลาดต่อไป
สลัว http
ตั้งค่า http = server.createObject (microsoft.xmlhttp)
http.open get, url, false
http.send ()
ถ้า http.readystate <> 4 แล้ว
ฟังก์ชั่นออก
สิ้นสุดถ้า
gethttppage = bytes2bstr (http.responsebody)
ตั้งค่า http = ไม่มีอะไร
ถ้า err.number <> 0 จากนั้น err.clear
end functionfunction bytes2bstr (vin)
Dim BytessTream, StringReturn
Set ByTessTream = Server.CreateObject (ADODB.Stream)
BytessTream.type = 2
BytessTream.Open
BytessTream.WriteText Vin
BytessTream.position = 0
BytessTream.Charset = GB2312
BytessTream.position = 2
stringReturn = bytessTream.readText
BytessTream.close
Set BytessTream = ไม่มีอะไร
bytes2bstr = stringreturn
end functionfunction getasphttppage (url)
ถ้า url = จากนั้น
ฟังก์ชั่นออก
สิ้นสุดถ้า
ตั้งค่า httpoBj = server.createObject (asphttp.conn)
'ตั้งค่าพร็อกซีเซิร์ฟเวอร์ผู้ใช้ที่ใช้พร็อกซีเพื่อเข้าถึงอินเทอร์เน็ตจำเป็นต้องตั้งค่าตัวเลือกนี้
ถ้า proxyip = 1 แล้ว
httpobj.proxy = 192.168.5.254: 808
สิ้นสุดถ้า
httpobj.timeout = 45
httpobj.url = url
httpoBj.requestMethod = รับ
getaphttppage = httpobj.geturl
ตั้งค่า httpobj = ไม่มีอะไร
end functionfunction isobjinstalled (strclassstring)
เมื่อเกิดข้อผิดพลาดต่อไป
isobjinstalled = false
err = 0
dim xtestobj
SET XTESTOBJ = Server.CreateObject (strClassString) ถ้า 0 = err แล้ว
ถ้า asphttpopen = 1 แล้ว
isobjinstalled = true
'response.write ส่วนประกอบปัจจุบัน asphttp
อื่น
isobjinstalled = false
'response.write ส่วนประกอบปัจจุบัน xmlhttp
สิ้นสุดถ้า
อื่น
isobjinstalled = false
'response.write ส่วนประกอบปัจจุบัน xmlhttp
สิ้นสุดถ้าตั้งค่า xtestoBj = ไม่มีอะไร
err = 0
ฟังก์ชันสิ้นสุด