游戏界面下载,游戏Ui界面,PSD游戏分层素材

新闻资讯

触摸屏租赁
Touch screen rental

广告机租赁
Advertising rental

机器人租赁
Robot leasing

当前位置：首页 > > 如何用asp编写网站数据采集程序

如何用asp编写网站数据采集程序
一、网站数据采集方法

目前网站数据采集方法主要有两种，一是使用现成的软件，二是自己编写采集程序。

1、使用现成的软件

很多软件（例如网络信息采集大师、BK通用信息采集系统等）都能采集网上数据，只要你到baidu、Google中，以“数据采集软件”为关键词搜一下，即可找到。如今这类软件数量繁多，都是别人用C、DEPHI或VB写成的，一般都提供了免费版让你下载试用。它们虽然也能采集网上数据，但是采集后的数据要么不能入库，要么只能入库前10条；如果你想突破这种限制，就必须花钱购买其正式版了。笔者试用了所有的数据采集软件，发现都是如此！

2、自己编写ASP采集程序

既然现成的软件不能免费使用，为了省钱，只能自己编写ASP网站数据采集程序了！下面就是该程序的代码，如果你想免费采集网站数据，运行之即可。

二、网站数据采集过程

编写ASP网站数据采集程序，首先需要抓取远程网页的源代码。微软serverXMLHTTP组件能帮你抓取远程页面的二进制代码，然后将该代码转换成字符，进行截取、替换处理，即可得到想要的数据；最后再将数据显示出来、或者写入数据库中，整个采集工作就完成了。

三、如何抓取远程网页？

抓取远程HTML的二进制代码主要语句如下：

    Set Http = CreateObject("MSXML2.XMLHTTP")     '创建serverXMLHTTP组件
    Http.open "GET",src_ ,false
    Http.send()                                   '开始抓取
    if Http.readystate<>4 then
        exit sub
    end if
value_ = Http.responseBody         '抓取到的网页二进制代码存放在value_中
下面我们写一个steal()子程序，只要你提供一个网址url，即可利用它抓取URL网页的二进制代码，存放在value_变量中。
public sub steal()                      '窃取目标URL地址的HTML代码
if src_<>"" then                        'src_=目标URL地址
    dim Http
    set Http=server.createobject("MSXML2.XMLHTTP") '创建serverXMLHTTP组件
    Http.open "GET",src_ ,false
    Http.send()
    if Http.readystate<>4 then        '判断是否准备好
        exit sub
    end if
    value_= Http.responseBody         '抓取到网页
    if len(value_)<100 then
        response.write "获取远程文件 <a href="&url&" target=_blank>"&url&"</a> 失败。"
        response.end
    end if
    isGet_= True                '已抓取过标志isGet_
    set http=nothing
    if err.number<>0 then err.Clear
else
    response.Write("<script>alert(""请先设置src属性！"")</script>")
end if
end sub

四、将网页二进制代码转换成字符

现在只要你提供一个远程网页URL，然后调用上面的steal()，即可抓到该网页（二进制代码形式）；由于二进制代码无法显示，所以要显示抓到的网页、或者入库，还需要转换成字符，必须写一个转换函数BytesToBstr，将网页二进制代码转换成字符，代码如下：

private Function BytesToBstr(body,Cset) '二进制转换成字符
dim objstream
set objstream = Server.CreateObject("adodb.stream")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.Write body
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
set objstream = nothing
End Function

五、抓取网页实例

现在我们能真枪实弹地抓一个网页了！例如要抓取六安信息港网页（http://market.ah163.net/city/AllDisplay.php?page=1&cityid=13），可以写一个2hand-cj.asp文件，在该文件中定义一个clsThief类，类中含有上面的子程序和函数，代码如下：

<%
Dim Html,myThief,url_tittle

'====采集六安信息港帖子网址列表
set myThief=new clsThief
GetUrl="http://market.ah163.net/city/AllDisplay.php?page=1&cityid=13"
myThief.src=GetUrl
myThief.steal           '抓取远程GetUrl整个网页，并将该网页二进制代码转换成字符
url_tittle=myThief.value             '抓取的网页存在url_tittle中
Html=""&url_tittle&""                '最后结果存在Html中
Response.write Html                  '显示结果
Response.write "<br>"
set myThief=nothing                 '释放对象

Class clsThief    '定义一个clsThief类
Private value_    '窃取到的内容
Private src_      '要偷的目标URL地址
Private isGet_    '判断是否已经偷过

public property let src(str) '赋值—要偷的目标URL地址/属性
src_=str
end property

public property get value '返回值—最终窃取并应用类方法加工过的内容/属性
value=value_
end property

private sub class_initialize() '初始化clsThief类
value_=""
src_=""
isGet_= false
end sub

public sub steal()        '窃取目标URL地址的HTML代码/方法
if src_<>"" then
    dim Http
    set Http=server.createobject("MSXML2.XMLHTTP")
    Http.open "GET",src_ ,false
    Http.send()
    if Http.readystate<>4 then
        exit sub
    end if
    value_=BytesToBSTR(Http.responseBody,"GB2312")     '将网页二进制转换成字符
    if len(value_)<100 then
        response.write "获取远程文件 <a href="&url&" target=_blank>"&url&"</a> 失败。"
        response.end
    end if
    isGet_= True
    set http=nothing
    if err.number<>0 then err.Clear
else
    response.Write("<script>alert(""请先设置src属性！"")</script>")
end if
end sub

end class
%>
解释一下以上程序中几个关键的语句：
GetUrl=http://market.ah163.net/city/AllDisplay.php?page=1&cityid=13 '要采集的网址
myThief.src=GetUrl                   '网址赋予myThief.src
myThief.steal        '调用steal方法抓取远程网页，并将该网页二进制代码转换成字符
url_tittle=myThief.value             '抓取的网页存放在url_tittle中
Html=""&url_tittle&""                '最后结果存放在Html中
Response.write Html                  '使用response显示抓取的网页

运行上面的2hand-cj.asp可以成功地抓取网页，结果如下图1所示！

接下来对于抓取的网页，我们只想保留表格（如上图）、其他的数据全不要，该怎么办呢？这就需要对抓取的网页进行截取了！

六、对抓取的网页进行截取

首先写个截取子程序cutBy(head,headCusor,bot,botCusor)，它可以按照你指定的首尾字符串、及位置偏移指针，对抓取的网页进行裁减。程序中参数head,headCusor,bot,botCusor分别是首字符串，首偏移值，尾字符串，尾偏移值；偏移值单位为字符数，向前偏移为负值，向后偏移为正值。

public sub cutBy(head,headCusor,bot,botCusor)
if isGet_= false then call steal()
On Error Resume Next
url=src_
value_=mid(value_ ,instr(value_ ,head)+len(head)+headCusor,instr(value_ ,bot)-1+botCusor-instr(value_ ,head)-len(head)-headcusor)
If Err.Number<>0 Then Response.Write "裁减<a href="&url&" target=_blank>"&url&"</a> 失败。"
end sub
把以上cutBy子程序添加到clsThief类中，然后在2hand-cj.asp中增加如下调用：
<%
    s1="<tr bgcolor=#FFFFFF>"         '要裁减的起始标志为<tr bgcolor=#FFFFFF>
    pos1="-22"                       '距起始标志向前22个字符,从此处开始裁减
    s2="var x = 50,y = 60"            '要裁减的结束标志
    pos2="-2055"                      '距结束标志向前2055个字符,到此处结束裁减
    myThief.cutBy s1,pos1,s2,pos2     '开始裁减
url_tittle=myThief.value          '获得裁减的内容
Html=""&url_tittle&""               '最后结果保存在Html中
Html="<table width=""100%"" border=""0"" cellspacing=""1"" cellpadding=""0"" bgcolor=#cccccc>"&Html              '最前部添加<table …等字符，以便显示完整表格
Response.write Html                 '显示结果
%>

七、替换网页中的数据

检查一下抓取的表格中每个帖子网址，其格式均为InformationDisplay.php?id=，这样的网址是不正确的！应该替换成http://market.ah163.net/city/InformationDisplay_enter.php?id=才行，所以我们在clsThief类中再增加一个替换程序change(oldStr,str)，用于替换网址，其中参数oldStr,str分别是旧字符串，新字符串。

public sub change(oldStr,str)   '对偷到的内容中的个别字符串用新值更换/方法
if isGet_= false then call steal()
value_=replace(value_ , oldStr,str)
end sub
    同时在2hand-cj.asp中也增加如下调用：
<%
    myThief.change "<a href=""InformationDisplay.php?id=","<a href="" http://market.ah163.net/city/InformationDisplay_enter.php?id="
%>
    执行2hand-cj.asp，表格中帖子的网址InformationDisplay.php?id=都会替换成http://market.ah163.net/city/InformationDisplay_enter.php?id=
这样帖子的网址都正确生成了。

八、截取帖子标题、网址等

现在我们需要截取每个帖子的标题、网址、方式、价格、时间（如上图2）这些数据，然后将之写入库中，为此，再写一个GetKey函数，负责截取这些数据，从Start开始截取，到Last截取结束

Function GetKey(HTML,Start,Last)
filearray=split(HTML,Start)
filearray2=split(filearray(1),Last)
GetKey=filearray2(0)
End Function

tittle=GetKey(HTML,"<font color=black>","</font></a> </td>")，其他数据的截取如法炮制，先确定截取的起始和结束标志，然后调用GetKey截取。

因此在2hand-cj.asp中增加如下语句：
'-----截取帖子标题
    tittle=GetKey(HTML,"<font color=black>","</font></a> </td>")
    tittle=mid(tittle,6)     '去掉头部前6个非显示字符
'-----截取帖子网址
    url=GetKey(HTML,"<td> <a href=""",""" target=""_blank""><font color=black>")
    url=TRIM(url)           '去掉空格
'-----得到大类别和小类别
    CateIDText=GetKey(HTML,"[","]")   '截取类别数据
    CateIDText=TRIM(CateIDText)
    select case CateIDText
    case "交通"                       '如果类别数据=交通
        CateID=8                      ' 大类别CateID就等于8
        SubCateID=1                   ' 小类别SubCateID就等于1
    case "游戏"
        CateID=1
        SubCateID=26
    case "电脑"
        CateID=1
        SubCateID=1
    case "房产"
        CateID=6
        SubCateID=1
    case "通讯"
        CateID=2
        SubCateID=1
    case "宠物"
        CateID=31
        SubCateID=221
    case "求职"
        CateID=37
        SubCateID=230
    case "影音"
        CateID=4
        SubCateID=1
    case "家用"
        CateID=5
    case "书籍"
        SubCateID=1
        CateID=17
    case "其它"
        CateID=0
        SubCateID=1
    end select
'-----取得方式
    fangshi=GetKey(HTML,"<td width=""60"">","</font></div>")
    fangshi=TRIM(right(fangshi,4))
    select case fangshi
    case "求购"
        SoftType="买进"
    case "出售"
        SoftType="卖出"
    end select
    if instr(fangshi,""">")>0 then fangshi="其他"      '如果fangshi含有字符"> 则fangshi="其他"
'-----取得价格
    jiage=GetKey(HTML,"<td width=""50"">","</div>")
    jiage=TRIM(mid(jiage,44))
'-----取得帖子发布日期
    DayDate=GetKey(HTML,"<td width=""80"">","</div>")
    DayDate=right(DayDate,10)
'-----显示得到的帖子数据
    Response.write tittle
    Response.write url
    Response.write fangshi
    Response.write jiage
    Response.write DayDate

九、帖子数据入库

最后要把帖子数据tittle、url、fangshi、jiage、DayDate写入#2hand.mdb库中，为防止帖子重复入库，需要写个testsj函数来判断某帖子是否已入库了，假如某帖子URL在库中找不到，则将该帖入库，否则就不予入库，代码如下：

'检测库中是否有某帖子的URL
Function testsj(titURL)
sql="select * from SoftDown_SoftInfo where url like '%"&titURL&"%' "
set rs=server.createobject("adodb.recordset")
rs.open sql,conn,1,1
    if rs.bof and rs.eof then
        testsj=True
        ErrMsg=ErrMsg & "<br><li>你要找的帖子不存在，或者已经被管理员删除！</li>"
    else
        testsj=false   '库中无该帖子的URL
    end if
rs.close
set rs=nothing
End Function
接下来打开数据库语句如下：
db="#2hand.mdb"
Set conn = Server.CreateObject("ADODB.Connection")
connstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(db)
conn.Open connstr
'-----判断帖子是否已经入库?
    FoundErr=False
    FoundErr=testsj(url)
'-----帖子数据写入库中
    if FoundErr=True then
        set rs=server.createobject("adodb.recordset")
        sql="select * from SoftDown_SoftInfo where (SoftID is null)"
        rs.open sql,conn,1,3
        if rs.bof and rs.eof then
            ErrMsg=ErrMsg & "<br><li>你要找的帖子不存在，或者已经被管理员删除！</li>"
        else
            ArticleTitle=rs("SoftName")
        end if
        rs.addnew
        rs("SoftName")=tittle
        rs("url")=url
        rs("CateID")=CateID           '所属大类
        rs("SubCateID")=SubCateID     '所属小类
        rs("SoftType")=fangshi        '出售\买进\出租\求租等方式
        rs("SoftSize")=jiage          '价格
        rs("hfsj")=DayDate            '发布时间
        rs.update
        rs.close
        set rs=nothing
        Response.write " 该帖入库成功<br><br>"
    end if

十、结束语

以上程序2hand-cj.asp在WinXP+IIS6环境下调试成功。只要你运行该程序，即可将网页http://market.ah163.net/city/AllDisplay.php?page=1&cityid=13中每个帖子的标题、网址、方式、价格、时间全部采集下来，写入到数据库#2hand.mdb中！

提示：2hand-cj.asp中并没有截取帖子的内容，只要你利用采集到的帖子网址，抓取对应的网页，然后再通过首尾标志即可截取帖子的内容，限于篇幅，这里就不展开介绍了！

另外，2hand-cj.asp中的取截取标志也都是常量，如果你把它们全部换成<input>文本框变量、要抓取的网址也换成<input>变量，2hand-cj.asp就会变成一个通用的网站数据采集软件，这些工作本文也不再讨论了，留给大家自己去修改扩展吧！

十一、附2hand-cj.asp程序全部清单

程序中使用的数据库#2hand.mdb请到我的小站http://www.labxw.com/#2hand.mdb下载。注意：测试程序时，建议你先清空#2hand.mdb中数据；另外，帖子是不会重复入库的，即假如某帖子已经写入#2hand.mdb中了，再次执行2hand-cj.asp后，该帖子还是不会再写入#2hand.mdb中的！

<%
Dim Html,Html1,xx,connstr,conn,rs,sql,s1,s2,pos1,pos2
dim myThief,page,username,hfsj,url_tittle,url,tittle,CateIDText,CateID,SubCateID,db,FoundErr

'====采集六安信息港帖子网址列表
set myThief=new clsThief
GetUrl="http://market.ah163.net/city/AllDisplay.php?page=1&cityid=13"
myThief.src=GetUrl
myThief.steal       '抓取远程GetUrl整个网页，并将该网页二进制代码转换成字符
'-----截取帖子网址列表
s1="<tr bgcolor=#FFFFFF>"           '要截取的起始标志
pos1="-22"                         '距起始标志向后196个字符,从此处开始截取
s2="var x = 50,y = 60"              '要截取的结束标志
pos2="-2055"                        '距结束标志向前2055个字符,到此处结束截取
myThief.cutBy s1,pos1,s2,pos2       '开始截取
myThief.change "<a href=""InformationDisplay.php?id=","<a href=""http://market.ah163.net/city/InformationDisplay_enter.php?id="   '前一个网址被后一个替换
url_tittle=myThief.value             '获得截取的内容
Html=""&url_tittle&""                '最后结果存放在Html中
Html="<table width=""100%"" border=""0"" cellspacing=""1"" cellpadding=""0"" bgcolor=#cccccc>"&Html
Response.write Html                   '显示结果
Response.write "<br>"
set myThief=nothing '释放对象
call tzrk()
Response.write "六安信息港二手帖子全部入库完毕<br><br>"

Class clsThief    '定义一个clsThief类
Private value_    '窃取到的内容
Private src_      '要偷的目标URL地址
Private isGet_    '判断是否已经偷过

public property let src(str) '赋值—要偷的目标URL地址/属性
src_=str
end property

public property get value '返回值—最终窃取并应用类方法加工过的内容/属性
value=value_
end property

private sub class_initialize()
value_=""
src_=""
isGet_= false
end sub

public sub steal() '窃取目标URL地址的HTML代码/方法
if src_<>"" then
    dim Http
    set Http=server.createobject("MSXML2.XMLHTTP")
    Http.open "GET",src_ ,false
    Http.send()
    if Http.readystate<>4 then
        exit sub
    end if
    value_=BytesToBSTR(Http.responseBody,"GB2312")
    if len(value_)<100 then
        response.write "获取远程文件 <a href="&url&" target=_blank>"&url&"</a> 失败。"
        response.end
    end if
    isGet_= True
    set http=nothing
    if err.number<>0 then err.Clear
else
    response.Write("<script>alert(""请先设置src属性！"")</script>")
end if
end sub

'按指定首尾字符串位置偏移指针对偷取的内容进行裁减/方法
public sub cutBy(head,headCusor,bot,botCusor)
'参数分别是首字符串,首偏移值,尾字符串,尾偏移值,左偏移用负值,偏移指针单位为字符数
if isGet_= false then call steal()
On Error Resume Next
url=src_
value_=mid(value_ ,instr(value_ ,head)+len(head)+headCusor,instr(value_ ,bot)-1+botCusor-instr(value_ ,head)-len(head)-headcusor)
If Err.Number<>0 Then Response.Write "截取<a href="&url&" target=_blank>"&url&"</a> 失败。"
end sub

'对偷到的内容中的个别字符串用新值更换/方法
public sub change(oldStr,str) '参数分别是旧字符串,新字符串
if isGet_= false then call steal()
value_=replace(value_ , oldStr,str)
end sub

end class

sub tzrk()
'-----打开数据库
db="#2hand.mdb"
Set conn = Server.CreateObject("ADODB.Connection")
connstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(db)
conn.Open connstr
xx=1
do while xx<=40
'-----截取帖子标题、网址
    tittle=GetKey(HTML,"<font color=black>","</font></a> </td>")
    tittle=mid(tittle,6)     '去掉头部前6个非显示字符
    url=TRIM(GetKey(HTML,"<td> <a href=""",""" target=""_blank""><font color=black>"))
'-----取得大小类别
    CateIDText=GetKey(HTML,"[","]")
    CateIDText=TRIM(CateIDText)
    select case CateIDText
    case "交通"
        CateID=8
        SubCateID=1
    case "游戏"
        CateID=1
        SubCateID=26
    case "电脑"
        CateID=1
        SubCateID=1
    case "房产"
        CateID=6
        SubCateID=1
    case "通讯"
        CateID=2
        SubCateID=1
    case "宠物"
        CateID=31
        SubCateID=221
    case "求职"
        CateID=37
        SubCateID=230
    case "影音"
        CateID=4
        SubCateID=1
    case "家用"
        CateID=5
    case "书籍"
        SubCateID=1
        CateID=17
    case "其它"
        CateID=0
        SubCateID=1
    end select
'-----取得方式
    fangshi=GetKey(HTML,"<td width=""60"">","</font></div>")
    fangshi=TRIM(right(fangshi,4))
    select case fangshi
    case "求购"
        SoftType="买进"
    case "出售"
        SoftType="卖出"
    end select
    if instr(fangshi,""">")>0 then fangshi="其他"      '如果fangshi含有字符"> 则fangshi="其他"
'-----取得价格、发布日期
    jiage=GetKey(HTML,"<td width=""50"">","</div>")
    jiage=TRIM(mid(jiage,44))
    DayDate=GetKey(HTML,"<td width=""80"">","</div>")
    DayDate=right(DayDate,10)
'-----显示已经抓取的帖子各项目
    Response.write tittle
    Response.write url
    Response.write fangshi
    Response.write jiage
    Response.write DayDate
'-----判断帖子是否已经入库?
    FoundErr=False
    FoundErr=testsj(url)
'-----帖子项目写入库中
    if FoundErr=True then
        set rs=server.createobject("adodb.recordset")
        sql="select * from SoftDown_SoftInfo where (SoftID is null)"
        rs.open sql,conn,1,3
        if rs.bof and rs.eof then
            ErrMsg=ErrMsg & "<br><li>你要找的帖子不存在，或者已被删除！</li>"
        end if
        rs.addnew
        rs("SoftName")=tittle
        rs("url")=url
        rs("CateID")=CateID           '所属大类
        rs("SubCateID")=SubCateID     '所属小类
        rs("SoftType")=fangshi        '出售\买进\出租\求租等方式
        rs("SoftSize")=jiage          '价格
        rs("hfsj")=DayDate            '发布时间
        rs.update
        rs.close
        set rs=nothing
        Response.write " 该帖入库成功<br><br>"
    end if
'-----处理下一个帖子
    xx=xx+1
    pos=instr(HTML,"</tr>")           '每行标识</tr>
    HTML=mid(HTML,pos+1)              '截取标识行下面的部分
    loop
end sub

'声明截取的格式，从Start开始截取，到Last为结束
Function GetKey(HTML,Start,Last)
filearray=split(HTML,Start)
filearray2=split(filearray(1),Last)
GetKey=filearray2(0)
End Function

'检测库中是否有URL
Function testsj(titURL)
sql="select * from SoftDown_SoftInfo where url like '%"&titURL&"%' "
set rs=server.createobject("adodb.recordset")
rs.open sql,conn,1,1
    if rs.bof and rs.eof then
        testsj=True
        ErrMsg=ErrMsg & "<br><li>你要找的帖子不存在，或者已被删除！</li>"
    else
        testsj=false
    end if
rs.close
set rs=nothing
End Function
%>

在抓到的网页代码中（下图3）我们发现，每个帖子的标题都位于<font color=black>和</font></a> </td>之间，所以按照如下格式调用GetKey截取帖子的标题：
再次执行2hand-cj.asp ，效果如下图2，只保留了表格，大功告成！
为了您的安全，请只打开来源可靠的网址
打开网站取消
来自: http://hi.baidu.com/ibmblog/blog/item/5115d6270835993f8744f9bf.html