ASP批量采集代码

Dim strurl

strurl = Getarrayurl(Request("dname"))

Function Getarrayurl(str)'====采集的域名串处理

If str = "" Then exit Function

str_ = Replace(str,chr(13),","销指)

str_ = Replace(str_,chr(10),"")

str_ = Replace(str_," ","")

Getarrayurl = str_

End function

If strurl <>"" Then Call CmfeiShow()

Sub CmfeiShow()

strurl_ = split(strurl,",")

For i=0 to Ubound(strurl_)

If i>2 Then Exit For '===最多辩备采集的网页个数

If left(strurl_(i),7)="http://" Then

strShow = GetKey(getHTTPPage(strurl_(i)),"<h1>","</h1>")

Response.Write strShow &"<br/>"

End If

Next

End Sub

例子:http://www.cmfei.net/asp/demo/CmfeiGet2.asp本亏灶配例子只采集最靠前的三个网页的<title>标签的内容。。

caiurl是采集源网址，pcontent=bytestobstr(getbody(caiurl),"gb2312") 是采集调用代码，如果采集的目清团标页面是utf-8格式的，请把gb2312修改成utf-8,即pcontent=bytestobstr(getbody(caiurl),"utf-8")

<%

response.charset="gb2312"

response.expires = -9999

response.addheader "pragma","no-cache"

response.addheader "cache-ctrol","no-cache"

caiurl="网址/qqlogin.js"

function getbody(weburl)

dim objxmlhttp

set objxmlhttp=server.createobject("msxml2.serverxmlhttp")

'如果服务器不支持msxml2.serverxmlhttp，可以修如正燃改成msxml3.serverxmlhttp或msxml6.serverxmlhttp或msxml2.xmlhttp

objxmlhttp.open "get",weburl,false

objxmlhttp.send

while objxmlhttp.readystate <>4

objxmlhttp.waitforresponse 10000

wend

getbody=objxmlhttp.responsebody

set objxmlhttp=nothing

end function

function bytestobstr(body,cset)

'-----------------

dim objstream

set objstream = server.createobject("adodb.stream")

objstream.type = 1

objstream.mode =3

objstream.open

objstream.write body

objstream.position = 0

objstream.type = 2

objstream.charset = cset

bytestobstr = objstream.readtext

objstream.close

set objstream = nothing

'-----------------

end function

pcontent=bytestobstr(getbody(caiurl),"gb2312")

response.write(pcontent)

%>

这样就渣虚可以把 网址/qqlogin.js 这个js文件采集到了，并存在pcontent变量中，如果要加入自己的代码，再把pcontent修改一下即可。

---