• 企业400电话
  • 微网小程序
  • AI电话机器人
  • 电商代运营
  • 全 部 栏 目

    企业400电话 网络优化推广 AI电话机器人 呼叫中心 网站建设 商标✡知产 微网小程序 电商运营 彩铃•短信 增值拓展业务
    也谈采集入库的技术
     

    落伍的贴也看了很多了,发现了很多讲小偷技术的,如精华贴里的--小偷程序原理和简单示例:
    [url]http://www.im286.com/viewthread.php?tid=407182extra=page%3D1[/url] 等等,也有提供采集程序下载的,但我还没看到一篇完整的入库的文章,或许是我看的贴少吧。虽然不是很深奥,我还是讲讲吧,希望高手别见笑啦,以前发了个原创的影视系

    统,却没落伍,这次再求落伍啦,希望大家帮顶下,也希望我能落伍!!
    入库也和小偷一样,要先得到需入库的部分,我这里以[url]http://www.skycn.com/article/77.html[/url] 为例了
    %
    dim url,mydate
    url="http://www.skycn.com/article/77.html" '定义url地址
    Set OXML = server.CreateObject("Microsoft.XMLHTTP") 
    '下面定义两个函数,得到数据
    Private Function BytesToBstr(body)  '利用流进行中文编码
    Set ADOS = Server.CreateObject("ADODB.Stream")
            Dim Bdat
            Bdat=Body
            ADOS.Type = 1
            ADOS.Mode =3
            ADOS.Open
            ADOS.Write Bdat
            ADOS.Position = 0
            ADOS.Type = 2
            ADOS.Charset = "GB2312"
            BytesToBstr = ADOS.ReadText 
            ADOS.Close
    End Function
    Public Function GetData(byref url) '利用OXML得到数据
            'on error resume next 
            SourceCode = OXML.open ("GET",url,false)
            OXML.send() 
            if OXML.readystate>4 then exit function
            GetData = BytesToBstr(OXML.responseBody)'
            if err.number>0 then err.Clear
    End Function
    mydate=getdata(url)
    mydate=Replace(mydate,chr(34),"") '去掉一些特殊字符,如双引号等,看自己情况定
    mydate=Replace(mydate,chr(16),"")
    response.write mydate
    %>
    我们就得到了以下的数据:
    '''''''''''''''''''''''''code start''''''''''''
    省列去部分..............
    href='../article/1034.html'>宽带用户需注意的七大安全/A>br>br>/td>/tr>/table> /td> td 

    width=20>/td> td vAlign=top width=540> table border=0 width=540 borderColorDark=#ffffff 

    borderColorLight=#cccccc cellPadding=0 cellSpacing=0> tr>td width='100%' align='center' 

    bgcolor='#CED7F1' height='20'>b>font color='#000000'>03月10日值得注意病毒列表

    /font>/b>      b>访问次数:/b>24345/td>/tr>tr>td 

    bgcolor='#000000' height='1'>/td>/tr>tr>td width='100%' align='center'>br>b>作者:/b>

    瑞星  b>来源:/b>font color=#000000>瑞星/font>  b>加入时间:

    /b>2006-03-10  /td>/tr>tr>td>br>    据瑞星全球反病毒监测

    网介绍,今日有一个病毒特别值得注意,它是:“hotmail蠕虫(Worm.Hotmatom)”病毒。该病毒是全球

    第一个专门针对Hotmail编写的蠕虫病毒,当用户登陆到MSN Hotmail发送邮件的时候,会被偷偷插入带毒

    链接,收信人点击后就可能中毒。br>br>    本日热门病毒:

    br>br>    “hotmail蠕虫(Worm.Hotmatom)”病毒:警惕程度★★★☆,蠕虫

    病毒,通过MSN Hotmail传播,依赖系统:WIN9X/NT/2000/XP。br>br>    病毒

    感染计算机后,会把自己复制到“windows”目录下,病毒文件名为“dho.exe”。病毒会修改注册表,每

    次打开计算机后都自动运行,然后在后台监视用户的IE浏览器。当用户登陆到MSN Hotmail发送邮件时,

    病毒会在发送的邮件后插入病毒文字和链接:“Hi, Happy San Valentin Day Download you Postcards 

    from http://***.miarroba.com(情人节到了,去**网站下载贺卡吧)”,用户点击该链接后就会中毒。

    br>br>    反病毒专家建议电脑用户采取以下措施预防该病毒:建立良好的安全

    习惯,不打开可疑邮件和可疑网站;关闭或删除系统中不需要的服务;很多病毒利用漏洞传播,一定要及

    时给系统打补丁;安装专业的防毒软件进行实时监控,平时上网的时候一定要打开防病毒软件的实时监控

    功能。br>br>iframe name=import_frame width=1 height=1 

    src=http://iplog.skycn.com/articlefrom.php?id=77 frameborder=no>/iframe>/td>/tr>TR>TD 

    bgColor=#cccccc height=1>/TD>/tr>tr>td>b>br>相关文章:/b>/td>/tr> tr>td>li 

    type=circle> A href='../article/2887.html' target=_blank title='阅读文章[QQ又带新病毒:恐怖

    的智能流氓软件]'>QQ又带新病毒:恐怖的智能流氓软件/A>br>li type=circle> A 

    href='../article/827.html' target=_blank title='阅读文章[03月08日值得注意病毒列表]'>03月08日

    值得注意病毒列表/A>br>li type=circle> A href='../article/1126.html' target=_blank 

    title='阅读文章[失恋日记实为电脑病毒 疑为学生失恋后制造]'>失恋日记实为电脑病毒 疑为学生失恋

    后制造/A>br>li type=circle> A href='../article/102.html' target=_blank title='阅读文章[

    黑客盯上“血馒头”!6成论坛含病毒链接]'>黑客盯上“血馒头”!6成论坛含病毒链接/A>br>li 

    type=circle> A href='../article/2885.html' target=_blank title='阅读文章[病毒总结:狗年春节

    间木马和QQ病毒多发]'>病毒总结:狗年春节间木马和QQ病毒多发/A>br>li type=circle> A 

    href='../article/995.html' target=_blank title='阅读文章[四类病毒可能在春节发作 专家提醒应及

    时防范]'>四类病毒可能在春节发作 专家提醒应及时防范/A>br>li type=circle> A 

    href='../article/3056.html' target=_blank title='阅读文章[专家表示:BT下载不会耗费硬盘 更不

    会带来病毒]'>专家表示:BT下载不会耗费硬盘 更不会带来病毒/A>br>li type=circle> A 

    href='../article/1229.html' target=_blank title='阅读文章[千万QQ表情暗藏病毒:背后另有惊人秘

    密]'>千万QQ表情暗藏病毒:背后另有惊人秘密/A>br>li type=circle> A 

    href='../article/938.html' target=_blank title='阅读文章[微软live遭钓鱼网站仿冒 病毒伪装MSN

    测试版传播]'>微软live遭钓鱼网站仿冒 病毒伪装MSN测试版传播/A>br>li type=circle> A 

    href='../article/315.html' target=_blank title='阅读文章[上网不用防火墙!一招克死所有病毒]'>

    上网不用防火墙!一招克死所有病毒/A>br>/td>/tr>tr>td>b>br>相关软件:/b>/td>/tr> 

    tr>td>li type=circle> A href='../soft/6805.html' target=_blank title='浏览软件[金山毒霸

    引擎病毒库升级包(2006.03.09)]'>金山毒霸引擎病毒库升级包(2006.03.09)/A>br>li type=circle> 

    A href='../soft/3722.html' target=_blank title='浏览软件[F-Secure Anti-Virus 病毒码省列去部

    分..............
    ''''''''''''''''''''''''''''code end '''''''''''''''''
    我们所需要的也就定义在mydate里了,但如何来定位呢?大家都知道asp里有left()和right() 函数,我

    们就用它们来做。我们先来定个函数,
    Public Function finddate(byref str,byref start,byref last,byref n)
            If Instr(lcase(str),lcase(start))>0 then
                    select case n
                    case 0        '左右都截取(都取前面)(去处关键字)
                    finddate=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
                    finddate=Left(finddate,Instr(lcase(finddate),lcase(last))-1)
                    case 1        '左右都截取(都取前面)(保留关键字)
                    finddate=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
                    finddate=Left(finddate,Instr(lcase(finddate),lcase(last))+Len(last)-1)
                    end select
            Else
                    finddate=""
            End if
    end function
    这个就是截取里面内容的函数了
    下面我们来得到文章标题:03月10日值得注意病毒列表
    dim title,artor,content,wherefrom
    title=finddate(mydate,"width=540 borderColorDark=#ffffff 

    borderColorLight=#cccccc",/font>/b>,1)
    这样,我们就把标题定位到了个小范围内了:width=540 borderColorDark=#ffffff 

    borderColorLight=#cccccc cellPadding=0 cellSpacing=0> tr>td width='100%' align='center' 

    bgcolor='#CED7F1' height='20'>b>font color='#000000'>03月10日值得注意病毒列表/font>/b>
    在精确定位下就行了,
    title=finddate(title,"font color='#000000'>","/font>/b>",0)
    现在,title的值就是:03月10日值得注意病毒列表
    artor=finddate(mydate,"作者:/b>","  b>",0) '得到作者
    wherefrom=finddate(mydate,"来源:/b>font color=#000000>","/font>  ",0)'得到来源
    content=finddate(mydate,"/td>/tr>tr>td>br>","br>br>iframe name=import_frame",0)'得到

    正文内容
    至此,我们已经得到了我们想要的数据了,在下来就是把title,artor,content,wherefrom 入库了,

    其实采集入库就怎么简单了,只是在用finddate()是要注意里面byref start和byref last,最好是

    mydate里面唯一的,这样便于定位。如不是唯一的,我们可以先缩小范围再来精确定位。有必要时可以弄

    个循环来得到数据。完整的代码如下
    ''''''''''''''''''''code start'''''''''''''''''''
    %
    dim url,mydate
    url="http://www.skycn.com/article/77.html"
    Set OXML = server.CreateObject("Microsoft.XMLHTTP") 
    '下面定义两个函数,得到数据
    Private Function BytesToBstr(body)  '利用流进行中文编码
    Set ADOS = Server.CreateObject("ADODB.Stream")
            Dim Bdat
            Bdat=Body
            ADOS.Type = 1
            ADOS.Mode =3
            ADOS.Open
            ADOS.Write Bdat
            ADOS.Position = 0
            ADOS.Type = 2
            ADOS.Charset = "GB2312"
            BytesToBstr = ADOS.ReadText 
            ADOS.Close
    End Function
    Public Function GetData(byref url) 
            'on error resume next 
            SourceCode = OXML.open ("GET",url,false)
            OXML.send() 
            if OXML.readystate>4 then exit function
            GetData = BytesToBstr(OXML.responseBody)'
            if err.number>0 then err.Clear
    End Function
    mydate=getdata(url)
    mydate=Replace(mydate,chr(34),"") '去掉一些特殊字符,如双引号等,看自己情况定
    mydate=Replace(mydate,chr(16),"")
    Public Function finddate(byref str,byref start,byref last,byref n)
            If Instr(lcase(str),lcase(start))>0 then
                    select case n
                    case 0        '左右都截取(都取前面)(去处关键字)
                    finddate=Right(str,Len(str)-Instr(lcase(str),lcase(start))-Len(start)+1)
                    finddate=Left(finddate,Instr(lcase(finddate),lcase(last))-1)
                    case 1        '左右都截取(都取前面)(保留关键字)
                    finddate=Right(str,Len(str)-Instr(lcase(str),lcase(start))+1)
                    finddate=Left(finddate,Instr(lcase(finddate),lcase(last))+Len(last)-1)
                    end select
            Else
                    finddate=""
            End if
    end function
    dim title,artor,content,wherefrom
    title=finddate(mydate,"width=540 borderColorDark=#ffffff 

    borderColorLight=#cccccc","/font>/b>",1)
    title=finddate(title,"font color='#000000'>","/font>/b>",0)
    artor=finddate(mydate,"作者:/b>","  b>",0)
    wherefrom=finddate(mydate,"来源:/b>font color=#000000>","/font>  ",0)
    content=finddate(mydate,"/td>/tr>tr>td>br>","br>br>iframe name=import_frame",0)
    call intomdb(title,artor,content,wherefrom)

    function intomdb(title,artor,content,wherefrom)
    '''''''''''''''''''''''''''''''''''
    '''这个是入库的函数,自己定义下就可以了
    ''''''''''''''''''''''''''''''''''' 
    end function
    %>
    我这里只是以采集文章为例,其它的采集软件等都是这个道理。
    说了怎么多,我也不知道各位能不能看懂,如看不动那可能是我不会表达了,大家见谅。毕竟我没读过文

    科,^_^

    我只是讲原理,程序是靠自己写的,要采集的速度快,你还可以写成exe的啊,这样比较快,占内存少
    上一篇:E-mail表单递交
    下一篇:先锋海盗类
  • 相关文章
  • 

    © 2016-2020 巨人网络通讯 版权所有

    《增值电信业务经营许可证》 苏ICP备15040257号-8

    也谈采集入库的技术 也,谈,采集,入库,的,技术,