当前位置: 首页 > 图文教程 > 网络编程 > ASP > ASP 自动采集实现代码

ASP
对连串英文自动换行的解决方法 IE5.5
怎样写你自己的EMAIL组件(原理)
ASP中有关timeout超时的体会
用ASP实现从SQL Server导出数据到Access
ASP向NT域中加一个用户
ASP乱码的解决方法
关于 aspsmartupload 注册问题
利用XML不离开页面刷新数据
IIS 处理 SEARCH 请求漏洞
不用组件实现上载功能(1)
不用组件实现上载功能(2)
在网页中实现OICQ里的头像选择的下拉框
仅用xsl和asp实现分页功能
如何使用context()方法将数据置入表格(XML)
利用ASP从远程服务器上接收XML数据
将数据库里面的内容生成EXCEL
怎样在ASP里面创建统计图表
加密你的Access数据库
利用global.asp定时执行ASP
加密QueryString数据

ASP 自动采集实现代码


出处:互联网   整理: 软晨网(RuanChen.com)   发布: 2010-01-10   浏览: 92 ::
收藏到网摘: n/a

通过XML中的XMLHTTP组件调用其它网站上的网页,然后批量截取或替换原有的信息使其转化成变量后再一一储存到数据库中。 其主要的优点便是无需再手工添加大量的信息了,可以指定对某一个站信息的截取进行批量录入,达到省时省力的目的。与其单纯的ASP小偷程序不同的是:它已经不再依赖其目标网站。
参考代码:
复制代码 代码如下:

<%
'声明取得目标信息的函数,通过XML组件进行实现。
Function Geturl(/blog/url)
Set Retrieval = CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "GET", url, False
.Send
GetURL = bytes2bstr(.responsebody)
'对取得信息进行验证,如果信息长度小于100则说明截取失败
if len(.responsebody)<100 then
response.write "获取远程文件 <a href="&url&" target=_blank>"&url&"</a> 失败。"
response.end
end if
End With
Set Retrieval = Nothing
End Function
' 二进制转字符串,否则会出现乱码的!
function bytes2bstr(vin)
strreturn = ""
for i = 1 to lenb(vin)
thischarcode = ascb(midb(vin,i,1))
if thischarcode < &h80 then
strreturn = strreturn & chr(thischarcode)
else
nextcharcode = ascb(midb(vin,i+1,1))
strreturn = strreturn & chr(clng(thischarcode) * &h100 + cint(nextcharcode))
i = i + 1
end if
next
bytes2bstr = strreturn
end function
'声明截取的格式,从Start开始截取,到Last为结束
Function GetKey(HTML,Start,Last)
filearray=split(HTML,Start)
filearray2=split(filearray(1),Last)
GetKey=filearray2(0)
End Function
Dim Softid,Url,Html,Title
'获取要取页面的ID
SoftId=Request("Id")
Url="http://www3.skycn.com/soft/"&SoftId&".html"
Html = Geturl(/blog/Url)
'以截取天空软件的软件名为例子
Title = GetKey(Html,"<font color='#004FC6' size='3'>","</font></b></td></tr>")
'打开数据库,准备入库
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
Response.Write"采集完毕!"
%>