asp 采集实战代码

答案：最近实在是太流行采集了，本人是不喜欢采集的，但对采集的原理我却很有兴趣进行研究，拿到了网上采集常用函数，对其进行了一番研究，并实战，结果成功，撇开效率问题，采集原理并不复杂，大家可以在搜索吧输入“采集”查看其原理。下面是一个采集的例子： 
[复制此代码]CODE:

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

上一个：解决采集时出现msxml3.dll 错误的方法
下一个：用ASP生成UTF-8网页文件的两种方法