最近實在是太流行採集了,本人是不喜歡採集的,但對採集的原理我卻很有興趣進行研究,拿到了網上採集常用函數,對其進行了一番研究,並實戰,結果成功,撇開效率問題,採集原理並不復雜,大家可以在搜索吧輸入“採集”查看其原理。下面是一個採集的例子:
複製代碼代碼如下:
<%@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組件進行實現。
FunctionGetURL(url)
SetRetrieval=server.createobject("MSXML2.XMLHTTP")
WithRetrieval
.Open"GET",url,False
.Send
If.Status<>200then'判斷文檔是否已經解析完,以做客戶端接受返回消息
exitfunction
EndIf
'二進制轉字符串
GetURL=sTb(.responsebody)
endwith
'對取得信息進行驗證,如果信息長度小於100則說明截取失敗
EndFunction
'二進制轉字符串,否則會出現亂碼的!
FunctionsTb(vin)
ConstadTypeText=2
DimBytesStream,StringReturn
SetBytesStream=Server.CreateObject("ADODB.Stream")
WithBytesStream
.Type=adTypeText
.Open
.WriteTextvin
.Position=0
.Charset="GB2312"
.Position=2
StringReturn=.ReadText
.Close
EndWith
SetBytesStream=Nothing
sTb=StringReturn
EndFunction
FunctionNewstring(Wstr,Strng)
Newstring=Instr(Lcase(Wstr),Lcase(Strng))
IfNewstring<=0ThenNewstring=Len(Wstr)
EndFunction
'聲明截取的格式,從Start開始截取,到Over為結束
FunctionGetKey(HTML,Start,Over)
Start=Newstring(HTML,start)
Over=Newstring(HTML,Over)
GetKey=Mid(HTML,Start,Over-start)
EndFunction
DimSoftid,Url,Html,Title
'採集百度知道
Fori=1to100
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/>")