Re: [PerlChina] perl作版本更新的时候站中的模块如何维护

#!/usr/bin/env perl
print my $cwd=dirname(__FILE__);
push @INC,$cwd;
push @INC,'/usr/lib/perl5/HTML/';
use LWP;
use Data::Dumper;
use HTML::Form;
use File::Basename;
use threads;
use Data::Dumper;
use strict;
use HTML::LinkExtractor;
my $ua=&ua;
my $loginurl="http://www.phpchina.com/home/do.php?ac=insertinto&ref";
my $home='http://www.phpchina.com/home/space.php';
my $baseurl='http://www.phpchina.com/home/';
my $page='http://www.phpchina.com/home/space.php?do=top&view=updatetime&page=';
my @users=({'name'=>'toad','formhash'=>'2bdb4038','password'=>'toad'},{'name'=>'firedtoad','formhash'=>'341584c7','password'=>'firedtoad'});
sub ua {
my $u=LWP::UserAgent->new('Agent'=>'Mozilla/5.0 (Windows; U; Windows NT 5.1; zh-CN; rv:1.9.2.13) Gecko/20101203 Firefox/3.6.13 (.NET CLR 3.5.30729)','cookie_jar'=>{});
push @{ $u->requests_redirectable }, 'POST';
$u;
}
sub work{
my $user=shift;
print Dumper($user);
open O,">>$user->{'name'}.html";
my @form=('username'=>$user->{'name'},
'password'=>$user->{'password'},
'formhash'=>'ec02b0e1',
'refer'=>'space.php?do=home',
'loginsubmit'=>'登录');
my $rs=$ua->post($loginurl,\@form);
if($rs->is_success){
# print $rs->content;
print O ($rs->content);
}else{
print $rs->status_line;
}
close O;
my $i=0;
open O,">>frend$user->{'name'}.html";
for my $no (1..50){
my $rs=$ua->get($page.$no);
my $LX=new HTML::LinkExtractor;
$LX->parse(\$rs->content);
for my $link (@{$LX->links}){
print Dumper($link);
if($link->{'tag'} eq 'a'&& $link->{'title'} eq qw{加好友}){
print $baseurl.$link->{'href'};
my @form=('refer'=>$page.$no,'addsubmit'=>'true','formhash'=>$user->{'formhash'},'gid'=>'0');
$rs=$ua->post($baseurl.$link->{'href'},\@form);
print O ($rs->content);
sleep(30);
}
}
}
close O;
}
sub main{
for my $user (@users){
threads->create(\&work,$user);
}
for (threads->list()){
$_->join();
}
}
&main;
#!/usr/bin/env perl
use LWP;
use Data::Dumper;
use HTML::Form;
use JSON;
use Switch;
use HTML::Form;
use File::Basename;
use XML::Simple;
use URI::Escape;
use URI;
use URI::QueryParam;
push @INC,dirname(__FILE__);
use Javascript::MD5;
use JavaScript::Runtime;
use File::Basename;
use Data::Dumper;
use threads;
use threads::shared;
use strict;
#binmode(STDIN, ':encoding(utf8)');
#binmode(STDOUT, ':encoding(utf8)');
#binmode(STDERR, ':encoding(utf8)');
my $mt:shared;
use lib './';
my $firstPG='http://ui.ptlogin2.qq.com/cgi-bin/login?target=self&style=4&appid=1003903&enable_qlogin=0&no_verifyimg=1&s_url=http%3A%2F%2Fweb2.qq.com%2Floginproxy.html%3Flogin_level%3D3&f_url=loginerroralert';
my $loginURL='http://ptlogin2.qq.com/login';
my $verifyURL='http://ptlogin2.qq.com/check?appid=#APPID#&uin=#UIN#&r=';
my $VURL='http://ui.ptlogin2.qq.com/cgi-bin/ver';
my $homeUrl='http://home.pengyou.com/index.php?mod=home';
my $channelURL='http://d.web2.qq.com/channel/login2';
my $logProxy='http://d.web2.qq.com/proxy.html?v=20101025002';
my $firstProy='http://web2.qq.com/loginproxy.html?login_level=3';
my $realLoginURL='http://d.web2.qq.com/channel/poll2?';
my $onlineStatus='http://d.web2.qq.com/channel/get_online_buddies2?';
my $friendURL='http://s.web2.qq.com/api/get_user_friends2';
my $cwd=dirname(__FILE__);
chdir($cwd);

my $rt = JavaScript::Runtime->new();
my $cx = $rt->create_context();
my $js=Javascript::MD5->javascript();
my $PASS;
$cx->bind_function(write => sub { $PASS=shift; });
my $jsTT.=
<<EOT;
function md5_3(B){
var A=new Array;
A=core_md5(str2binl(B),B.length*chrsz);
A=core_md5(A,16*chrsz);
A=core_md5(A,16*chrsz);
return binl2hex(A)
}function md5(A){
return hex_md5(A)
}
function preprocess(P,V){
var T="";
T+=V;
T=T.toUpperCase();
return md5(md5_3(P).toUpperCase()+T).toUpperCase();
}
write(preprocess("#P#","#V#"));
EOT
sub genPass{
my ($P,$V)=@_;
my $jst=$jsTT;
$jst=~s/#P#/$P/g;
$jst=~s/#V#/$V/g;
my $tjs=$js.$jst;
$cx->eval($tjs);
return $PASS;
}
sub ua {
use HTTP::Cookies;
my $cookie_jar = HTTP::Cookies->new(file => "lwp_cookies.dat", autosave => 1);
my $u=LWP::UserAgent->new('agent'=>'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1');
$u->cookie_jar($cookie_jar);
push @{ $u->requests_redirectable }, 'POST';
$u;
}
sub get{
my ($ua,$url)=@_;
my $rs=$ua->get($url);
return $rs->content if($rs->is_success);
return $rs->status_line;
}
sub post{
my ($ua,$url,@form)=@_;
my $rs=$ua->post($url,\@form);
return $rs->content if($rs->is_success);
return $rs->status_line;
}
sub getVerifyCode{
my ($ua,$appid,$uid)=@_;
my $VURL=$verifyURL;
$VURL=~s/#APPID#/$appid/g;
$VURL=~s/#UIN#/$uid/g;
# print my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =localtime(time);
$VURL.="0.".time.reverse(time);
my $rs =$ua->get($VURL);
my $ctx=$rs->content;
$ctx=~/,\'(.*)\'/g;
$1;
}
sub getV{
my $ua=shift;
my $rs=$ua->get($VURL);
print $rs->content."\n";
}
sub login{
my ($ua,$u,$p,$v)=@_;
print $p,$v;
# my $pass=genPass($p,$v);
my $qp=URI->new("", "http");
$qp->query_param(u => $u);
$qp->query_param(p => $p);
$qp->query_param(aid => '1003903');
$qp->query_param(fp => 'loginerroralert');
$qp->query_param(dumy =>'');
$qp->query_param(from_ui => '1');
$qp->query_param(h => '1');
$qp->query_param(mibao_css => '');
$qp->query_param(ptlang => '2052');
$qp->query_param(ptredirect => '1');
$qp->query_param(pttype => '1');
$qp->query_param(remember_uin => '1');
$qp->query_param(u1 => 'http://web2.qq.com/loginproxy.html?login_level=3');
$qp->query_param(verifycode => $v);
# print Dumper($qp);
my $getStr=$loginURL."?".$qp->query;
print $getStr=($getStr);
print "\n";
open F,">login.html";
binmode(F, ':encoding(utf-8)');
my $rs=$ua->get($getStr);
print $rs->content;
print F ($rs->content);
close F;
}
sub gotoHome{
my $ua=shift;
open F,">home.html";
# binmode(F, ':encoding(utf8)');
my $rs=$ua->get($homeUrl);
print $rs->content;
print F ($rs->content);
close F;
}
sub readUsers{
my $xml=XMLin('users.xml');
$xml->{'user'};
}
sub getFistPG{
my $ua=shift;
open FP,">firstPG.html";
print FP (get($ua,$firstPG));
close FP;
}
sub channelLogin{
my $ua=shift;
print my $ptwebqq=$ua ->{cookie_jar}->{COOKIES}->{'.qq.com'}->{'/'}->{'ptwebqq'}[1];
my $clientid=int(rand(99)).time%1000000;
my @form=('r'=>qw{\{"status":"","ptwebqq":"}.$ptwebqq.qw{","passwd_sig":"","clientid":"}.$clientid.qw{","psessionid":null\}});
# my @form=('r'=> '{"status":"","ptwebqq":"4814b0b42af1b1c5939c2eac68c11f8f407cbed31e704465f6b571ec76bd98f4","passwd_sig":"","clientid":"22850164","psessionid":null}');
my $rs=$ua->post($channelURL,\@form);
# print Dumper(@form);
($clientid,$rs->content);
}
sub getFriends{
my ($ua,$pv)=@_;
my @form=('r'=>'{"h":"hello","vfwebqq":'."\"$pv\"}");
print post($ua,$friendURL,@form);
}
sub getFirstProxy{
my $ua=shift;
get($ua,$firstProy);
}
sub getLogProxy{
my $ua=shift;
get($ua,$logProxy);
}
sub realLogin{
my ($ua,$cid,$pvid,$vf)=@_;
my $t=substr(time,0);
print my $getstr=$realLoginURL."clientid=$cid&psessionid=$pvid&t=$t&vfwebqq=$vf";
my $rs=$ua->get($getstr);
open F ,">error.html";
binmode(F, ':encoding(gbk)');
my $ctx=$rs->content;
$ctx=~s/\\\\u/\\u/g;
print F ($ctx);
close F;
# print Dumper($rs);
# print Dumper($ua);
}
sub getOnline{
my ($ua,$cid,$pvid,$vf)=@_;
my $t=substr(time,0);
print my $getstr=$onlineStatus."clientid=$cid&psessionid=$pvid&t=$t";
my $rs=$ua->get($getstr);
print $rs->content;
}

sub work{
my ($ua,$user,$v,$p)=@_;
getV $ua;
login $ua,$user->{'username'},$p,$v;
$ua->default_headers()->push_header('Referer'=>$logProxy);
my @channelRs=channelLogin $ua;
my $clientId=@channelRs[0];
print @channelRs[1];
my $json=new JSON;
my $rs=$json->jsonToObj(@channelRs[1]);
print Dumper($rs);
getLogProxy $ua;
# print $rs->{'retcode'};
my $ps=$rs->{'result'}->{'psessionid'};
my $vf=$rs->{'result'}->{'vfwebqq'};
getOnline $ua, $clientId,$ps;
getFriends $ua, $vf;
while(1){
realLogin $ua,$clientId,$ps,$vf;
sleep(10);
}
# sleep(1000);
}

sub main{
my $users=readUsers();
for my $user(@{$users}){
my $ua=&ua;
my $v=getVerifyCode $ua,"1003903",$user->{'username'};
my $p=genPass($user->{'pass'},$v);
threads->create(\&work,$ua,$user,$v,$p);
}
for my $th(threads->list()){
$th->join();
}
sleep(10);
}
main;#!/usr/bin/env perl
use LWP;
use Data::Dumper;
use HTML::Form;
use Switch;
use HTML::Form;
use File::Basename;
use strict;
my $user="firedtoad";
my $pass="zwhdhrdj";
my $ua=&ua;
my $loginurl='https://passport.baidu.com/?login';
my $home='http://hi.baidu.com/firedtoad/home';
my $blogsub='http://hi.baidu.com/firedtoad/commit';
my $createURL='http://hi.baidu.com/firedtoad/creat/blog/';
my $cwd=dirname(__FILE__);

sub ua {
my $u=LWP::UserAgent->new('agent'=>'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1','refferer'=>'http://hi.baidu.com/firedtoad/home','cookie_jar'=>{});
push @{ $u->requests_redirectable }, 'POST';
$u;
}
sub login{
open F,">log.html";
my @form=("username"=>$user,'return_method'=>'get','more_param'=>'loginlogin','refferer'=>'http://hi.baidu.com/firedtoad/home','mem_pass'=>'on',"password"=>$pass);
my $rs=$ua->post($loginurl,\@form);
if($rs->is_success){
# print $rs->content;
print F ($rs->content);
}else{
print $rs->status_line;
}
}
sub gotoHome{
my $rs=$ua->get($home);
open F,">home.html";
print F ($rs->content);
close F;
}
sub readFile{
print my $file=shift;
open F,"<$file";
my $f;
while($f=<F>){
# print $f;
}
close F;
return $f;
}
sub getToken{
my $rs=$ua->get($createURL);
my @form=HTML::Form->parse($rs->decoded_content,$createURL);
# print Dumper(@form);
@form[0]->{'inputs'}[0]->{'value'};
}
sub subFile{

opendir D ,"$cwd/cpp";
my @files=readdir D;
closedir D;
my $file='1001';
for my $f(@files){
next if($f eq '.'||$f eq '..');
next if(index($f,'.cpp')==-1);
open F,"<$cwd/cpp/$f";
my $str;
while($str.=<F>){
$str.='<br/>';
last if(eof(F));
}
$f=~s/\.cpp//g;
# print $f;
my $tk=getToken();
my @form=('cm'=>1,'ct'=>1,'spBlogPower'=>0,'spIsCmtAllow'=>1,'bdstoken'=>$tk,
'spShareNotAllow'=>0,'spBlogTitle'=>"$f\_c++",'spBlogText'=>$str,'spBlogCatName'=>'c++');
@form;
my $rs=$ua->post($blogsub,\@form);
# print $rs->content;
open BLOG,">>blogcpp.html";
print BLOG ($rs->content);
close BLOG;
open L,">>$cwd/logcpp";
print L ($f."\n");
close L;
sleep(120);
}

}
sub main{
&login;
&gotoHome;
&subFile;
}
&main;小子发现perlchina 很久没有大规模讨论技术问题了，貌似都骗到MM，回家生孩子了？？
于是乎小子决定挑个头,发几个perl工具供大家讨论一下.
解释一下：
main.pl phpchina刷分外挂
PluginBase.pl webqq挂机外挂 可以基于此开发qqapp的各种外挂有兴趣的可联系小子啦
submitTiBaiduPP.pl 百度空间发帖外挂
这个帐号不常用 联系 firedtoad@gmail.com

--
您收到此邮件是因为您订阅了 Google 网上论坛的"PerlChina Mongers 讨论组"论坛。
要向此网上论坛发帖，请发送电子邮件至 perlchina@googlegroups.com。
要取消订阅此网上论坛，请发送电子邮件至 perlchina+unsubscribe@googlegroups.com。
若有更多问题，请通过 http://groups.google.com/group/perlchina?hl=zh-CN 访问此网上论坛。