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
エンド関数