asp 采集实战代码

最近实在是太流行采集了,本人是不喜欢采集的,但对采集的原理我却很有兴趣进行研究,拿到了网上采集常用函数,对其进行了一番研究,并实战,结果成功,撇开效率问题,采集原理并不复杂,大家可以在搜索吧输入“采集”查看其原理。下面是一个采集的例子: 代码如下: %@LANGUAGE='VBSCRIPT'CODEPAGE='65001'% %Response.CodePage=65001% %Response.Charset='UTF-8'% %Server.Scripttimeout=9999999 res

作者: 来源: 时间: 17-11-23 15:24:56

最近实在是太流行采集了,本人是不喜欢采集的,但对采集的原理我却很有兴趣进行研究,拿到了网上采集常用函数,对其进行了一番研究,并实战,结果成功,撇开效率问题,采集原理并不复杂,大家可以在搜索吧输入“采集”查看其原理。下面是一个采集的例子:
代码如下:
<%@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 
%>

11
22
33
隐藏区块

会员注册

本功能为预留功能,暂不支持注册 ^_^

Login

社交帐号登陆

使用以下任意帐号可登陆本站

Close section
Close

联系我们

关于5UCMS 您有任何需求 均可以留言给我们