asp 采集实战代码

　　<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>

　　<% Response.CodePage=65001%>

　　<% Response.Charset="UTF-8" %>

　　<%Server.Scripttimeout=9999999

　　response.expires = 0

　　response.expiresabsolute = Now() - 1

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

　　response.addHeader "cache-control","private"

　　Response.CacheControl = "no-cache"

　　%>

　　<%

　　'声明取得目标信息的函数,通过XML组件进行实现。

　　Function GetURL(url)

　　Set Retrieval = server.createobject("MSXML2.XMLHTTP")

　　With Retrieval

　　.Open "GET", url, False

　　.Send

　　If .Status<>200 then '判断文档是否已经解析完，以做客户端接受返回消息

　　exit function

　　End If

　　' 二进制转字符串

　　GetURL = sTb(.responsebody)

　　end with

　　'对取得信息进行验证，如果信息长度小于100则说明截取失败

　　End Function

　　' 二进制转字符串，否则会出现乱码的！

　　Function sTb(vin)

　　Const adTypeText = 2

　　Dim BytesStream,StringReturn

　　Set BytesStream = Server.CreateObject("ADODB.Stream")

　　With BytesStream

　　.Type = adTypeText

　　.Open

　　.WriteText vin

　　.Position = 0

　　.Charset = "GB2312"

　　.Position = 2

　　StringReturn = .ReadText

　　.Close

　　End With

　　Set BytesStream = Nothing

　　sTb = StringReturn

　　End Function

　　Function Newstring(Wstr,Strng)

　　Newstring=Instr(Lcase(Wstr),Lcase(Strng))

　　If Newstring<=0 Then Newstring=Len(Wstr)

　　End Function

　　'声明截取的格式，从Start开始截取，到Over为结束

　　Function GetKey(HTML,Start,Over)

　　Start=Newstring(HTML,start)

　　Over=Newstring(HTML,Over)

　　GetKey=Mid(HTML,Start,Over-start)

　　End Function

　　Dim Softid,Url,Html,Title

　　'采集百度知道

　　For i = 1 to 100

　　Url="http://zhidao.baidu.com/question/10000"&i&".html"

　　Html = GetURL(Url)

　　Question = GetKey(Html,"<cq>","</cq>")

　　Answer = GetKey(Html,"<ca>","</ca>")

　　Response.Write(Question&"<br />")

　　Response.Write(Answer)

　　Response.Write("采集成功")

　　Next

　　'打开数据库,准备入库

　　'dim connstr,conn,rs,sql

　　'connstr="DBQ="+server.mappath("db1.mdb")+";DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};"

　　'set conn=server.createobject("ADODB.CONNECTION")

　　'conn.open connstr

　　'set rs=server.createobject("adodb.recordset")

　　'sql="select [列名] from [表名] where [列名]='"&Title&"'"

　　'rs.open sql,conn,3,3

　　'if rs.eof and rs.bof then

　　'rs("列名")=Title

　　'rs.update

　　'set rs=nothing

　　'end if

　　'set rs=nothing

　　%>