免费注册 查看新帖 |

Chinaunix

  平台 论坛 博客 文库
最近访问板块 发新帖
查看: 14113 | 回复: 8
打印 上一主题 下一主题

perl轻松做简单的网络爬虫[ziluobu原创] [复制链接]

论坛徽章:
0
跳转到指定楼层
1 [收藏(0)] [报告]
发表于 2007-06-15 22:27 |只看该作者 |倒序浏览
近期本人闲来没事做了一个程序自动从一些BT网站上抓取数据并且自动发帖到我自己的论坛上,试用了几个月效果比较好,现在公布源代码供perl爱好者参考,我的qq是2637663欢迎广大perl爱好者一起沟通交流。
分几个程序组成
readcokie.pl 获取要上传主机的cookie一次获取永久在主机保存
fatie.pl         抓取源主机数据并自动发帖到目标主机
history.log   保存抓取过的数据
user.txt        发帖时使用的用户列表
..........

具体程序如下
readcokie.pl
======================
# -*- coding: gb2312 -*-
#$ua->post( $url, \%form )
#$ua->post( $url, \@form )
#$ua->post( $url, \%form, $field_name => $value, ... )
#This method will dispatch a POST request on the given $url, with %form or @form providing the key/value pairs for the fill-in form content. Additional headers and content options are the same as for the get() method.
#This method will use the POST() function from HTTP::Request::Common to build the request. See the HTTP::Request::Common manpage for a details on how to pass form content and other advanced features.
#$ua->get( $url )
#$ua->get( $url , $field_name => $value, ... )
#This method will dispatch a GET request on the given $url. Further arguments can be given to initialize the headers of the request. These are given as separate name/value pairs. The return value is a response object. See the HTTP::Response manpage for a description of the interface it provides.
#$ua->agent('Mozilla/5.0');
  use HTTP::Cookies;
  use HTTP::Request::Common qw(POST);
  use LWP::UserAgent;
    $ua = LWP::UserAgent->new;
  open(FILE,'D:\bin\posttools\自动发帖\bt区顶贴\cc8.cnsuk.net新沙加神话\data\user.txt');
  @file=<FILE>;
  for ($i=0;$i<=$#file;$i++){
    chomp($file[$i]);
    ($user,$pass)=split(/,/,$file[$i]);
    $ua->cookie_jar(HTTP::Cookies->new(file => "D:\\bin\\posttools\\自动发帖\\bt区顶贴\\cc8.cnsuk.net新沙加神话\\data\\$user\\cookie.txt",
                                     autosave => 1));
    $req =POST 'http://www1.5hxy.com/bbs/login.asp',
              [UserName => $user,
              Userpass => $pass,
              IsSave => '1',
              Eremite => '1',
              ];
    $res=$ua->request($req);
    $ua->cookie_jar->save;
#     $ua = LWP::UserAgent->close;   
    }




fatie.pl
=============================

  use HTTP::Cookies;
  use LWP;
  $ua = LWP::UserAgent->new;
  $ua->agent("Mozilla/8.0";
#初始化参数
$n_file='D:\bin\posttools\自动发帖\bt区顶贴\cc8.cnsuk.net新沙加神话\\';

###临时种子文件地址
#定义地址@url @postid @bankuainame  
$hhttp='http://cc8.cnsuk.net';
$url[0]='http://cc9.cnsuk.net/forum-2944-2.html';
$postid[0]='13';
$bankuainame[0]="$hhttp-游戏";

$url[1]='http://cc9.cnsuk.net/forum-2944-1.html';  
$postid[1]='13';
$bankuainame[1]="$hhttp-游戏";

$url[2]='http://cc9.cnsuk.net/forum-2905-2.html';  
$postid[2]='13';
$bankuainame[2]="$hhttp-游戏";

$url[3]='http://cc9.cnsuk.net/forum-2905-1.html';  
$postid[3]='13';
$bankuainame[3]="$hhttp-游戏";
while (1) {
  for ($u=0;$u<=$#url;$u++){
      $htms='';
      $res = $ua->get($url[$u]);
      $htms=$res->content;
      print "获取 $bankuainame[$u] 版块数据 \n";
      #获取后挑出有用的数据
      if ($res->is_success) {
          @html=();
          @html=split(/\n/,$htms);
          @link=();
          @tid=();
          @tti=();
          for(@html){
#<a href="thread-50813-1-1.html" style="font-weight: bold;color: green">[04.19][BT游戏最新补丁发布专用贴][暂放]</a><span class="lighttxt">

                #if (m{^<a href="(viewthread\.php\?tid=)(\d+)&.*>(.*)</a>}){
                if (m{^<a href="(thread\-)(\d*)(\-\d*\-\d*\.html)".*?>(.*?)</a>}){
                    push(@link,$1.$2.$3);
                    push(@tid,$2);
                    push(@tti,$4);
                }
          }
      }
      print "挑出有用的数据 $#link 个 \n";
      #历史记录
      open (FILE,$n_file.'data\history.log');
      @history=();
      @history=<FILE>;
      close FILE;
      #用户记录
      open(FILE,$n_file.'data\user.txt');
      @usertxt=();
      @usertxt=<FILE>;
      close FILE;
      #提交记录
      print "读取用户信息 \n";
      #检查帖子是否在历史,不在就发帖
      $chazhao=0;#是否找到0没找到
      for ($x=0;$x<=$#tid;$x++){
        for ($a=0;$a<=$#history;$a++){
            if ($history[$a]==$tid[$x]){
                $a=$#history+1;
                $chazhao=1;   
            }
        }
        print "帖子$tti[$x] $tid[$x] 找到标志为 $chazhao\n";
        if ($chazhao==0){ #如果历史没有就发帖
            #获取源帖子内容
            $url="$hhttp/$link[$x]";
            $res = $ua->get($url);
            $htmls=$res->content;
            #open (FILE,'>D:\bin\posttools\自动发帖\bt区顶贴\bbs.btpig.com猪猪乐园\bin\temp.log'); #debug
            #print FILE $htmls;                                                                    #debug
            #close FILE;                                                                           #debug
            @html=();
            @html=split(/\n/,$htmls);
            @torlink=();
            @tortid=();
            @torxylink=();
            @tortti=();
            $zd=0;
            #获取所有种子地址
                for(@html){
                #<a href="viewthread.php?tid=645515&extra=page%3D1" style="font-weight: bold;color: blue">[02.02][原创][美国][二战][二战电影五部][DVDRip][6.1G] 英文字幕</a>
                #<a href="attachment.php?aid=26721" target="_blank" class="bold">金庸群侠传全集★cc8cnsuk.net新沙加神话★VItas★.torrent</a> (2007-4-28 21:12, 17.35 K)<br>

                        if (m{<a href="(attachment\.php\?aid=)(\d+)".+?>(.+\.torrent)</a>}){
                        push(@torlink,$1.$2);
                        push(@tortid,$2);
                        push(@tortti,$3);
                        $zd=1;
                        }
                }
            #找到种子文件才发帖,否则不发帖
            if ($zd==1){
              $userc=int(rand($#usertxt));#选择哪个用户
              chomp($usertxt[$userc]);
              ($user,$pass)=split(/,/,$usertxt[$userc]);
              print "决定用户$userc发帖子\n";
              #获取种子
              @torxylink=();

              for ($f=0;$f<=$#tortid;$f++){
                $err=0;
                $url="$hhttp/$torlink[$f]";
                $res = $ua->get($url,referer=>$hhttp,);
                print "种子获取成功,开始上传种子\n";
                if ($res->is_success) {
                    $torrent=$res->content;
                    $filename="$n_file"."torrent\\temp\.torrent";
                    open (FILE2,">$filename";
                    binmode(FILE2);
                    print FILE2 $torrent;
                    close FILE2;
                    #上传种子
                    w1:{$ua->cookie_jar(HTTP::Cookies->new(file => "$n_file"."data\\$user\\cookie\.txt",
                    autosave => 0));
                    $ua->timeout(240);
                    $response = $ua->post('http://www3.5hxy.com/bbs/UploadAttachment.asp',
                    Content_Type => 'form-data',
                    Content      => [ file => ["$filename"],
                                    ],
                    referer=>'http://www3.5hxy.com/bbs/',);
                    #获取上传目标种子地址
                    #<a target=_blank href=UpFile/UpAttachment/2007-2/20072731345.torrent>http://www.5hxy.com/UpFile/UpAtt ... 20072731345.torrent</a>
                    if ($response->content=~m{(<a target=_blank href=.*?\.torrent.*?>}m){
                      push(@torxylink,$1.$tortti[$f].'</a>');
                      }else{
                      if ($err<=5){#如果没有错误5次继续尝试上传
                        $err++;
                        goto w1;  
                        }                     
                      }
                    last w1;
                    }
                }
              print "种子上传完毕\n";
              #sleep 3;
              }
              #拆分源帖子
              $zzdaot=0;
              $zzdaow=0;
              for ($s=0;$s<=$#html;$s++){
                #找帖子头部
                if ($zzdaot==0){
                  if ($html[$s]=~m/<table width="95%" border="0" cellspacing="0" cellpadding="0"/){
                    $tou=$s+39; #+5是头部偏移量
                    $zzdaot=1;
                  }
                }elsif ($zzdaow==0){
                  if ($html[$s]=~m/<table width="95%" border="0" cellspacing="0" cellpadding="0"/){
                    $wei=$s-30; #尾部偏移量
                    $zzdaow=1;
                  }
                }
              }
              #如果只找到头没有找到尾那么尾偏移30;
              if ($zzdaot==1 and $zzdaow=0){
                $wei=$tou+30;
              }
              #获取所有图片地址
              print "获取所有图片地址\n";
              @imgh=();
              for($b=$tou;$b<=$wei;$b++){
                    @imgh=split(/ /,$html[$b]);
                    for($j=0;$j<=$#imgh;$j++){
                #<img src="http://img.album.pchome.net/02/71/78/71/efe60b699dcfb8277e0eb309ce4ee1ce.jpg" border="0" onload="if(this.width>screen.width*0.7) {this.resized=true; this.width=screen.width*0.7; this.alt='Click here to open new window\nCTRL+Mouse wheel to zoom in/out';}" onmouseover="if(this.width>screen.width*0.7) {this.resized=true; this.width=screen.width*0.7; this.style.cursor='hand'; this.alt='Click here to open new window\nCTRL+Mouse wheel to zoom in/out';}" onclick="if(!this.resized) {return true;} else {window.open('http://img.album.pchome.net/02/71/78/71/efe60b699dcfb8277e0eb309ce4ee1ce.jpg');}" onmousewheel="return imgzoom(this);">
                      if ($imgh[$j]=~m{src="(.+\.jpg)"}){
                        $imgf=$1;
                          if ($imgf=~m/http/){
                            push(@img,"\[img\]$imgf\[/img\]";
                            }else{
                            push(@img,"\[img\]$hhttp/$imgf\[/img\]";
                            }
                          }
                      }
              }
              print "合并数据准备发帖\n";
              $constor='';
              #合并种子地址
              for ($b=0;$b<=$#torxylink;$b++){
                $constor.="<br><br> 本站种子地址torxylink[$b] <br><br>";
                }
              @torxylink=();
              #合并图片地址
              for ($b=0;$b<=$#img;$b++){
                $constor.="<br><br> $img[$b] <br><br>";
                }
              @img=();
              #合并要发送的数据
              $cons=$constor;
              for ($g=$tou;$g<=$wei;$g++){
                $cons.=$html[$g];
                }
              $cons=~s/<i.*?\/>//mg;
              $cons=~s/<d.*?>//mg;
              $cons=~s/<\/d.*?>//mg;
              $cons.="<br><br>此数据来自$hhttp/$link[$x] <br><br>";
              #####开始发帖子  哎,写了这么多终于可以发帖子了,真不容易
              $ua->cookie_jar(HTTP::Cookies->new(file => "$n_file"."data\\$user\\cookie\.txt",
                    autosave => 0));
                  $ua->timeout(240);
                  $url='http://www3.5hxy.com/bbs/AddTopic.asp?ForumID='.$postid[$u];
                  #开始发帖子
                  print "开始发帖\n";
                  $response = $ua->post( $url,
                          [ForumID => $postid[$u],
                          Subject => $tti[$x] ,
                          Body => $cons,
                          UpFileId=>1,
                          #content => $cons,
                          #DisableYBBCode => '0'
                          ],
                          referer=>'http://www3.5hxy.com/bbs/', );


            }
                      print "帖子 $tti[$x]$tid[$x] 记录历史完毕 \n";
                      open (FILE,">>$n_file".'data\history.log'); #回过帖子的记录起来
                      print FILE "$tid[$x]\n";
                      close FILE;
        }
      print "==================== $bankuainame[$u] =======================\n";
      $chazhao=0;
      }
  }
print "休眠1200秒 \n";
sleep 1200;
}

论坛徽章:
0
2 [报告]
发表于 2007-06-15 22:30 |只看该作者
希望这个帖子能够置顶,让更多perl爱好者学习。

论坛徽章:
0
3 [报告]
发表于 2007-06-15 22:46 |只看该作者
头像先过滤一下

论坛徽章:
0
4 [报告]
发表于 2007-06-16 02:21 |只看该作者
鼓励一下

论坛徽章:
0
5 [报告]
发表于 2007-06-16 09:41 |只看该作者
好复杂的脚本。。。啥时候能看懂啊,努力学习ing...

楼主把格式调整一下吧,好多笑脸在里面

论坛徽章:
0
6 [报告]
发表于 2007-06-16 22:08 |只看该作者
楼主以附件的形式传上来吧

论坛徽章:
0
7 [报告]
发表于 2007-06-18 17:37 |只看该作者
太强了..

论坛徽章:
0
8 [报告]
发表于 2007-06-18 22:36 |只看该作者

谢谢大家的鼓励,我现在给大家另外一个我做的程序

谢谢大家的鼓励,我现在给大家另外一个我做的程序
Perl轻松制作个人论坛顶贴宝宝,供perl爱好者学习

Perl轻松制作个人论坛顶贴宝宝
--河南 潘伟
一、前言
随着网络的盛行很多电脑爱好者都喜欢在网络上自己建立一个论坛,在上面放些大家喜欢的东西供网友欣赏,但是他们中大部分论坛访问量都很小,别人去他们的网站发现很冷清很多就走了,我写了一个关于个人网站顶贴宝宝的程序文章,他可以用不同的用户模拟人的常规语言顶贴,营造一个热闹的、良好的论坛氛围。我以BBSXP为例子给大家介绍,如果读者是其它类型的论坛可以根据情况修改代码。

二、开发步骤
1、首先在自己的论坛上注册几个专门用于顶贴的用户,并且把用户名、密码记录起来,按照下面格式保存在文件D:\bin\posttools\dingtie\data\user.txt中
feier,*****
直挂云帆, *****
惜爱者, *****
……
……
2、建立D:\bin\posttools\dingtie\data\posttxt.txt文件,在网上搜集些不代表个人观点的中性词编辑到里面,如“顶”这样的帖子没有产生对搂主帖子的任何关点,每一行为一句话。 例:
顶!!
顶顶顶!·
我顶
我就不顶。
你顶我也顶
顶死你
今天,。。。。。顶
……
……
顶贴用户和中性词越多越好,这样顶贴的用户和帖子内容重复的机会就会比较少,我写了200个中性词,注册了20个顶贴用户,在2个月的使用中感觉基本能够达到预期的效果。
3、在D:\bin\posttools\dingtie\data\目录下为每个顶贴用户建立一个自己名字的目录,用来存放自己的cookie信息。如在D:\bin\posttools\dingtie\data\下建立feier目录和直挂云帆、惜爱者目录。
4、在D:\bin\posttools\dingtie\bin目录建立readcokie.pl文件,编辑内容如下:
use HTTP::Cookies;
use HTTP::Request::Common qw(POST);
use LWP::UserAgent;
$ua = LWP::UserAgent->new;
open(FILE,'D:\bin\posttools\dingtie\data\user.txt');
@file=<FILE>;
for ($i=0;$i<=$#file;$i++){
chomp($file[$i]);
($user,$pass)=split(/,/,$file[$i]);
$ua->cookie_jar(HTTP::Cookies->new(file => "D:\\bin\\posttools\\dingtie\\data\\$user\\cookie.txt",
autosave => 1));
$req =POST 'http://www.5hxy.com/bbs/login.asp',
[UserName => $user,
Userpass => $pass,
IsSave => '1',
Eremite => '1',
];
$res=$ua->request($req);
$ua->cookie_jar->save;
}
上面代码的功能是读取D:\bin\posttools\dingtie\data\user.txt文件的用户名和密码,然后登陆论坛,并且将登录成功后论坛返回的cookie记录在D:\bin\posttools\dingtie\data\每个用户自己的目录里。由于我选择的是登陆cookie永不失效所以这个程序一般只需要执行一次当cookie获取成功后就不用再执行。
$req =POST 'http://www.5hxy.com/bbs/login.asp',
[UserName => $user,
Userpass => $pass,
IsSave => '1',
Eremite => '1',
];
这部分是根据论坛登陆页面<from>标签里的必要参数来填写的,你如果不是BBSXP的论坛可以根据<from>里的数据修改上面的代码。
5、在D:\bin\posttools\dingtie\bin目录建立dingtie.pl文件,编辑内容如下:
use HTTP::Cookies;
use LWP;
$ua = LWP::UserAgent->new;
while (1) {
# $ua->agent("$0/0.1 " . $ua->agent);
$ua->agent("Mozilla/8.0"); # pretend we are very capable browser
#获取版块数据
$url='http://www.5hxy.com/bbs/ShowForum.asp?ForumID=4';
$url2='http://www.5hxy.com/bbs/ShowForum.asp?ForumID=12';
$url3='http://www.5hxy.com/bbs/ShowForum.asp?ForumID=3';
$res = $ua->get($url);
$htms=$res->content;
$res = $ua->get($url2);
$htms.=$res->content;
$res = $ua->get($url3);
$htms.=$res->content;
print "获取版块数据 \n";
#获取后挑出有用的数据
if ($res->is_success) {
@html=();
@html=split(/\n/,$htms);
@link=();
for(@html){
if (m{<a href="ShowPost\.asp\?ThreadID=(\d+)">}){
push(@link,$1);
}
#$1 and
#}while m{<a href="ShowPost\.asp\?ThreadID=(\d+)">};
}
}
print "挑出有用的数据 $#link 个 \n";
#历史记录
open (FILE,'D:\bin\posttools\dingtie\data\history.log');
@history=();
@history=<FILE>;
close FILE;
#用户记录
open(FILE,'D:\bin\posttools\dingtie\data\user.txt');
@usertxt=();
@usertxt=<FILE>;
close FILE;
#提交记录
open(FILE,'D:\bin\posttools\dingtie\data\posttxt.txt');
@posttxt=();
@posttxt=<FILE>;
close FILE;
print "用户记录 \n";
#检查帖子是否在历史,不在就回帖
$chazhao=0;#是否找到0没找到
for ($x=0;$x<=$#link;$x++){
for ($a=0;$a<=$#history;$a++){
if ($history[$a]==$link[$x]){
$a=$#history+1;
$chazhao=1;
}
}
print "帖子 $link[$x] 找到标志为 $chazhao\n";
if ($chazhao==0){ #如果历史没有就回帖
$tiezi=int(rand($#usertxt));#随即数决定发几个帖子
print "决定发 $tiezi 个帖子\n";
for ($y=0;$y<=$tiezi;$y++){
$userc=int(rand($#usertxt));#选择哪个用户
print "决定用户$userc发帖子\n";

$neirong=int(rand($#posttxt));#选择哪个帖子
print "决定发哪个帖子 $neirong \n";

chomp($usertxt[$userc]);
($user,$pass)=split(/,/,$usertxt[$userc]);
$ua->cookie_jar(HTTP::Cookies->new(file => "D:\\bin\\posttools\\dingtie\\data\\$user\\cookie.txt",
autosave => 1));
#以用户身份看一下帖子
$url="http://www.5hxy.com/bbs/ShowPost.asp?ThreadID= $link[$x]";
$res = $ua->get($url);
$url='http://www.5hxy.com/bbs/ReTopic.asp';
#开始发帖子
$response = $ua->post( $url,
[ThreadID => $link[$x],
***ject => 'Re:回复',
content => $posttxt[$neirong],
Di***leYBBCode => '0',
Edit***mit =>' 回复 '],
referer=>'http://www.5hxy.com/bbs/', );
print "帖子回复完毕,内容 $posttxt[$neirong] \n";
sleep 5;
}
print "帖子 $link[$x] 记录历史完毕 \n";
open (FILE,'>>D:\bin\posttools\dingtie\data\history.log'); #回过帖子的记录起来
print FILE "$link[$x]\n";
close FILE;
}
$chazhao=0;
}
print "休眠600秒 \n";
sleep 600;
}

6、执行readcokie.pl后,执行dingtie.pl程序观察执行效果,如下:
获取版块数据
挑出有用的数据 179 个
用户记录
帖子 23151 找到标志为 1
帖子 11248 找到标志为 1
帖子 20728 找到标志为 1
帖子 819 找到标志为 1
帖子 22687 找到标志为 1
帖子 549 找到标志为 1
帖子 8946 找到标志为 1
帖子 126 找到标志为 1
帖子 446 找到标志为 1
帖子 49 找到标志为 0
决定发 6 个帖子
决定用户18 发帖子
决定发哪个帖子 180
帖子回复完毕,内容 !!!!!!

决定用户2 发帖子
决定发哪个帖子 3
帖子回复完毕,内容 我就不顶。

决定用户10发帖子
决定发哪个帖子 197
帖子回复完毕,内容 YA~ 我喜欢这贴子.哈哈
。。。。。。
。。。。。。
帖子 1082 找到标志为 1
帖子 1083 找到标志为 1
帖子 1084 找到标志为 1
帖子 1087 找到标志为 1
帖子 1089 找到标志为 1
帖子 1092 找到标志为 1
帖子 1090 找到标志为 1
休眠600秒

三、结束语
这个程序我之所以采用perl语言作为编写顶贴宝宝的原因主要还是因为perl强大的表达式和文字、网页、跨平台处理能力,简单的几行就已经完成了一个复杂的功能。本文不讲怎么搭建perl环境,如果读者不会搭建perl环境,或在修改程序的时候有什么问题可以到我的论坛http://www.5hxy.com/bbs大家一起交流,另外也可以到论坛下载整个程序的源代码。




作者:潘伟
地址:河南省紫金山路55号阳光铭座A座2203
邮编:450000
邮箱:zi_luo_bu@sina.com

论坛徽章:
0
9 [报告]
发表于 2007-06-19 08:53 |只看该作者
历害,收了,有时间学习学习.
您需要登录后才可以回帖 登录 | 注册

本版积分规则 发表回复

  

北京盛拓优讯信息技术有限公司. 版权所有 京ICP备16024965号-6 北京市公安局海淀分局网监中心备案编号:11010802020122 niuxiaotong@pcpop.com 17352615567
未成年举报专区
中国互联网协会会员  联系我们:huangweiwei@itpub.net
感谢所有关心和支持过ChinaUnix的朋友们 转载本站内容请注明原作者名及出处

清除 Cookies - ChinaUnix - Archiver - WAP - TOP