بعد الدراسة لمدة يومين ، قمت بإنشاء الكود التالي مع كل زميل. زحف البيانات غير صحيح.
set r = server.createObject (microsoft.xmlhttp)
R. open get ، url ، false ،
R.SetRequestHeader Penerer ، URL
ر
Str1 = B2S (R.ResponseBody)
str1 = استبدال (str1 ،،)
تعيين reg = جديد regexp
reg.Multiline = صحيح
reg.global = صحيح
reg.ignorecase = صحيح
str_top = <font color =#fb5e3c>
str_bottom = </font>
reg.pattern = & str_top & ((. |/n)*؟) & str_bottom &
تعيين المطابقات = reg.execute (STR1)
Str1 =
لكل مباراة 1 في المباريات
str1 = match1.value
التالي
تعيين المباريات = لا شيء
ضبط ريج = لا شيء
str1 = استبدال (استبدال (str1 ، str_top ،) ، str_bottom ،)
conn.execute (تحديث webtable set pr = '& str1 &' where 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> </body> </body> < /html>
الحالة 4
استجابة. write <br> & nbsp ؛ & nbsp ؛ خطأ غير معروف - لا يمكن أن يزحف البيانات ، من فضلك <font color> <a href = javaScript: location.reload () ؛> تحديث </a> </font> حاول مرة أخرى << /body> </html>
نهاية الاختيار
استجابة
end subsub google (strurl ، id ، all) url = http: //www.google.cn/search؟ complete = 1 & hl = zh-cn & q = site ٪ 3a & strurl && meta =
str = gethttppage (url)
إذا str = إذن
conn.execute (تحديث webtable set google = '0' where id = & id)
آخر
تعيين reg = جديد regexp
reg.Multiline = صحيح
reg.global = false
reg.ignorecase = صحيح
str_top = <td align = live nowrap> <font size = -1>
str_bottom = </font> </td> </tr> </table>
reg.pattern = & str_top & ((.)*) & str_bottom &
تعيين المطابقات = reg.execute (str)
لكل مباراة 1 في المباريات
str = match1.value
التالي
تعيين المباريات = لا شيء
إذا inst (str ، <html>) = 1 ثم
str2 = 0
آخر
str = split (str ، </b>)
str1 = str (3)
str2 = split (str1 ، <b>) (1)
إنهاء إذا
إذا str2 = أو len (str2)> 200 ثم
conn.execute (تحديث webtable set google = '0' where id = & id)
آخر
conn.execute (تحديث webtable set google = '& str2 &' where id = & id)
إنهاء إذا
إنهاء إذا
End Subsub Baidu (str ، id ، all) 'call print_do (baidu) إذا
url = http: //www.baidu.com/s؟ wd = site ٪ 3a & str && cl = 3
آخر
strect = split (str ،.)
url = http: //www.baidu.com/s؟ wd = & strect (0) && cl = 3
إنهاء إذا
'Response.write (<br> URL's Baidu: & url) إذا كان isobjinstalled (Asphttp.conn) = true ثم
str = getasphttppage (url)
آخر
str = gethttppage (url)
إنهاء إذا
إذا str = إذن
خطأ الاتصال (4)
آخر
تعيين reg = جديد regexp
reg.Multiline = صحيح
reg.global = false
reg.ignorecase = صحيح
str_top = <td align = yere nowrap>
str_bottom = </td>
reg.pattern = & str_top & ((. |/n)*؟) & str_bottom &
تعيين المطابقات = reg.execute (str)
لكل مباراة 1 في المباريات
str = match1.value
التالي
تعيين المباريات = لا شيء
set reg = nothingresponse.write <br>
'Response.write & nbsp ؛ & nbsp ؛
إذا str = أو len (str)> 200 ثم
conn.execute (تحديث webtable set baidu = '0' where id = & id)
آخر
إذا instr (str ، تقريبا) = 0 ثم
keyw = صفحة
آخر
keyw = تقريبي
إنهاء إذا
str = mid (str ، (instr (str ، keyw) +1) ، (instr (str ، article) -instr (str ، keyw) -1))
استجابة. write str
conn.execute (تحديث webtable set baidu = '& replace (استبدال (str ،،،) ،،) و "حيث id = & id)
إنهاء إذا
إنهاء إذا
End Subsub Alexa (Strurl ، ID)
url = http: //www.alexa.com/data/details/traffic_details؟ q = & url = & strurl
set r = server.createObject (microsoft.xmlhttp)
R. open get ، url ، false ،
R.SetRequestHeader Penerer ، URL
ر
str1 = bytes2bsstr (R.ResponseBody)
str1 = استبدال (str1 ،،)
تعيين reg = جديد regexp
reg.Multiline = صحيح
reg.global = صحيح
reg.ignorecase = صحيح
str_top = <!-هل تعلم
str_bottom = </span> <br>
reg.pattern = & str_top & ((. |/n)*؟) & str_bottom &
تعيين المطابقات = reg.execute (STR1)
Str1 =
لكل مباراة 1 في المباريات
str1 = str1 & match1.value
التالي
تعيين المباريات = لا شيء
ضبط ريج = لا شيء
str1 = استبدال (str1 ، <!-هل تعلم؟ Alexa يقدم هذه البيانات برمجيًا. تفضل بزيارة http://aws.amazon.com/awis لمزيد من المعلومات حول خدمة معلومات الويب Alexa.-> ،)
إذا str1 <> ثم
str1 = استبدال (str1 ، <span class ،)
str1 = استبدال (str1 ، </span> </span> ،)
str1 = استبدال (str1 ،،)
str1 = استبدال (str1 ، ،)
str1 = انقسام (str1 ، <br>) (0)
إذا كان CSTR (يمين (str1،7)) = </span> ثم
str1 = اليسار (trim (str1) ، len (str1) -7)
إنهاء إذا
إذا isnumeric (str1) ثم
num = str1
آخر
csstxt = getalexacss ()
num =
str1 = انقسام (str1 ، </span>)
لأني = 0 إلى Ubund (STR1)
str2 = str1 (i)
إذا تركت (str2 ، instr (str2 ، =)) <> ثم
num = num & Left (str2 ، instr (str2 ، =)-1)
str2 = يمين (str2 ، len (str2) -instr (str2 ، =))
إنهاء إذا
str3 = انقسام (str2 ،>)
لـ J = 0 إلى Ubund (Str3)
التالي
إذا str3 (0) <> ثم
إن لم يكن isnumberic (str3 (0)) ثم
إذا instr (csstxt ، str3 (0)) = 0 ثم
num = num & str3 (1)
إنهاء إذا
إنهاء إذا
إنهاء إذا
التالي
إنهاء إذا
آخر
num = 0
إنهاء إذا
SQL = تحديث WebTable Set Alexa = '& num &' where id = & id
Response.write (<script> ALERT ('& sql &') </script>)
conn.execute (SQL)
انهاء الوظائف الفرعية B2S (STR)
قاتمة س
set o = server.createBject (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) = صحيح ثم
str = getasphttppage (url)
آخر
str = gethttppage (url)
إنهاء إذا
getalexacss = str
end functionsub print_do (str)
استجابة. write <script>
استجابة. وظيفة Hiddenload ()
استجابة. write {
Response.write parent.do & str & .style.display = 'none' ؛
استجابة. write}
استجابة. write </script>
استجابة. write <body leftmargin = 0 topmargin = 0 marginWidth = 0 marginheight = 0 bgcolor =#f2f2f2 onload = hiddenload ()>
نهاية الوظائف الفرعية Gethttppage (URL)
عند استئناف الخطأ التالي
خافت HTTP
تعيين http = server.createBject (microsoft.xmlhttp)
http.Open get ، url ، false
http.send ()
إذا http.readyState <> 4 ثم
وظيفة الخروج
إنهاء إذا
gethtpage = bytes2bsstr (http.responsebody)
تعيين http = لا شيء
إذا err.number <> 0 ثم err.clear
end functionfunction bytes2bsstr (vin)
باهت بايتشر ، سلسلة
تعيين bytessTream = server.createBject (adodb.stream)
bytesstream.type = 2
bytesstream.Open
bytesstream.writetext vin
bytesstream.position = 0
bytesstream.charset = gb2312
bytesstream.position = 2
StringReturn = bytesstream.readtext
bytesstream.close
تعيين bytesstream = لا شيء
bytes2bstr = stringReTurn
end functionfunction getasphttppage (url)
إذا url = ثم
وظيفة الخروج
إنهاء إذا
تعيين httpobj = server.createBject (ASPHTTP.CONN)
"إعداد خادم وكيل ، والمستخدمون الذين يستخدمون الوكيل للوصول إلى الإنترنت يحتاجون إلى تعيين هذا الخيار
إذا proxyip = 1 ثم
httpobj.proxy = 192.168.5.254: 808
إنهاء إذا
httpobj.timeout = 45
httpobj.url = url
httpobj.requestmethod = get
getAphttppage = httpobj.geturl
تعيين httpobj = لا شيء
end functionfunction isobjinstalled (strclassstring)
عند استئناف الخطأ التالي
isobjinstalled = false
خطأ = 0
قاتمة xtestobj
SET XTESTOBJ = server.createBject
إذا ASPHTTPOPEN = 1 ثم
isobjinstalled = صحيح
'Response.write Current Component ASPHTTP
آخر
isobjinstalled = false
'Response.write Current Component XMLHTTP
إنهاء إذا
آخر
isobjinstalled = false
'Response.write Current Component XMLHTTP
end إذا تم تعيين xtestobj = لا شيء
خطأ = 0
وظيفة نهاية