<%@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  %>