清华大佬耗费三个月吐血整理的几百G的资源，免费分享！....>>>

#!/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;