2日間勉強した後、それぞれの同僚と共有しました。データクロールは正しくありません。
r = server.createObject(microsoft.xmlhttp)を設定します
r.open get、url、false、
R.SetRequestHeader参照、URL
R.Send
str1 = b2s(r.responsebody)
str1 =置換(str1 ,,,,)
reg = new 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&
一致= reg.execute(str1)を設定します
str1 =
一致の各マッチ1について
str1 = match1.value
次
一致=何も設定しません
reg =何も設定しません
str1 =交換(str1、str_top、)、str_bottom、)交換)
conn.execute(webtable set pr = '&str1&'を更新します=&id)
End Sub
サブエラー(str)ケースstrを選択します
ケース1
Response.Write <br>&nbsp;&nbsp;検索エンジンは空です。<a href = mailto:zhming11122 hotmail.com> [email protected] </a>にお問い合わせください
ケース2
respons.write <br>&nbsp;&nbsp;サイト名は空です。
ケース3
respons.write <br>&nbsp;&nbsp;入力した検索エンジンはこのプログラムでサポートされていません。 /html>
ケース4
respons.write <br>&nbsp;&nbsp;不明なエラー - データをクロールできない、<font color = blue> <a href = javascript:location.reload();> refresh </a> </font>再試行< /body> </html>
[選択]を終了します
Response.End
End Subsub Google(Strurl、id、all)
str = gethttppage(url)
str = thenの場合
conn.execute(webtable set google = '0'を更新するwhere id =&id)
それ以外
reg = new regexpを設定します
reg.multiline = true
reg.global = false
reg.ignorecase = true
str_top = <td align = suld nowrap> <font size = -1>
str_bottom = </font> </td> </tr> </table>
reg.pattern =&str_top&((。)*)&str_bottom&
一致= reg.execute(str)を設定する
一致の各マッチ1について
str = match1.value
次
一致=何も設定しません
If strust(str、<html>)= 1 then
str2 = 0
それ以外
str = split(str、</b>)
str1 = str(3)
str2 = split(str1、<b>)(1)
ifを終了します
str2 =またはlen(str2)> 200の場合
conn.execute(webtable set google = '0'を更新するwhere id =&id)
それ以外
conn.execute(webtable set google = '&str2&'を更新=&id)
ifを終了します
ifを終了します
subsub baidu(str、id、all) 'call print_do(baidu)all = n thenを終了します
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
ifを終了します
'Response.Write(<br> baiduのurl:&url)isobjinstalled(asphttp.conn)= true then
str = getAsphttppage(url)
それ以外
str = gethttppage(url)
ifを終了します
str = thenの場合
コールエラー(4)
それ以外
reg = new regexpを設定します
reg.multiline = true
reg.global = false
reg.ignorecase = true
str_top = <td align = suld nowrap>
str_bottom = </td>
reg.pattern =&str_top&((。|/n)*?)&str_bottom&
一致= reg.execute(str)を設定する
一致の各マッチ1について
str = match1.value
次
一致=何も設定しません
reg = NothingResponse.write <br>を設定します
'Response.Write&nbsp;&nbsp;
str =またはlen(str)> 200の場合
conn.execute(webtable set baidu = '0'を更新=&id)
それ以外
If strust(str、ほぼ)= 0 then
keyw =ページ
それ以外
keyw = compximate
ifを終了します
str = mid(str、(str(str、keyw)+1)、(str(str、article)-instr(str、keyw)-1))
Response.write str
conn.execute(upted webtable set baidu = '&falpled(flated(str ,,,)、)&' where id =&id)
ifを終了します
ifを終了します
サブサブ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参照、URL
R.Send
str1 = bytes2bstr(r.responsebody)
str1 =置換(str1 ,,,,)
reg = new regexpを設定します
reg.multiline = true
reg.global = true
reg.ignorecase = true
str_top = <! - ご存知ですか
str_bottom = </span> <br>
reg.pattern =&str_top&((。|/n)*?)&str_bottom&
一致= reg.execute(str1)を設定します
str1 =
一致の各マッチ1について
str1 = str1&match1.value
次
一致=何も設定しません
reg =何も設定しません
str1 =置換(str1、<! - ご存知ですか?Alexaはこのデータをプログラムで提供します。AlexaWeb情報サービスの詳細については、http://aws.amazon.com/awisにアクセスしてください。->、)
str1 <>の場合
str1 =置換(str1、<スパンクラス、)
str1 =置換(str1、</span> </span>、)
str1 =置換(str1 ,,)
str1 =置換(str1、、)
str1 = split(str1、<br>)(0)
cStr(右(str1,7))= </span> thenの場合
str1 = left(trim(str1)、len(str1)-7)
ifを終了します
is -numeric(str1)の場合
num = str1
それ以外
csstxt = getAlexacss()
num =
str1 = split(str1、</span>)
i = 0からubund(str1)
str2 = str1(i)
左(str2、str2(str2、=))<> thenの場合
num = num&left(str2、str2(str2、=)-1)
str2 = right(str2、len(str2)-instr(str2、=))
ifを終了します
str3 = split(str2、>)
j = 0からubund(str3)
次
str3(0)<> thenの場合
そうでない場合は、is -numeric(str3(0))
If strust(csstxt、str3(0))= 0 then
num = num&str3(1)
ifを終了します
ifを終了します
ifを終了します
次
ifを終了します
それ以外
num = 0
ifを終了します
sql = update webtable set alexa = '&num&' where id =&id
respons.write(<script> alert( '&sql&')</script>)
conn.execute(sql)
サブ機能B2S(STR)を終了
薄暗いo
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 =何も設定しません
end function 'AlexaのStyleSheetを取得します
関数getalexacss()
url = http://client.alexa.com/common/css/scramble.css
isobjinstalled(asphttp.conn)= trueの場合
str = getAsphttppage(url)
それ以外
str = gethttppage(url)
ifを終了します
getAlexacss = str
end functionsubprint_do(str)
Response.Write <Script>
respons.write関数hiddenload()
Response.Write {
Response.write parent.do&str&.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)を終了
エラーの再開時に次に再開します
dim http
http = server.createobject(microsoft.xmlhttp)を設定します
http.open get、url、false
http.send()
http.ReadyState <> 4の場合
出口機能
ifを終了します
gethttppage = bytes2bstr(http.responsebody)
http = Nothingを設定します
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
bytesstream = Nothingを設定します
bytes2bstr = stringreturn
end functionfunction getAsphttppage(url)
url = thenの場合
出口機能
ifを終了します
httpobj = server.createObject(asphttp.conn)を設定します
'プロキシサーバーを設定し、プロキシを使用してインターネットにアクセスするユーザーは、このオプションを設定する必要があります
proxyip = 1の場合
httpobj.proxy = 192.168.5.254:808
ifを終了します
httpobj.timeout = 45
httpobj.url = url
httpobj.RequestMethod = get
getaphttppage = httpobj.geturl
httpobj =何も設定しません
end functionfunction isobjinstalled(strclassstring)
エラーの再開時に次に再開します
isobjinstalled = false
err = 0
dim xtestobj
xtestobj = server.createobject(strclassstring)の場合は、0 = err thenを設定します
asphttpopen = 1の場合
isobjinstalled = true
'Response.Write CurrentコンポーネントASPHTTP
それ以外
isobjinstalled = false
'Response.Write Current Component XMLHTTP
ifを終了します
それ以外
isobjinstalled = false
'Response.Write Current Component XMLHTTP
set xtestobj = nothingの場合は終了します
err = 0
エンド関数