Форум АНТИЧАТ - Чекер прокси для контакта

perl
PHP код:

		
			
use LWP::UserAgent; 

use warnings;

use threads;

use threads::shared;

use Fcntl ':flock';



#=-=-=-=--==-====--=-======-=-=-=-==-====-=-==-=--==-==-=-=-=-==-=-=-=-=-==-=-



print q{

    proxy checker

    eLwaux(c)2008

 }."\n";

 

#=-=-=-=--==-====--=-======-=-=-=-==-====-=-==-=--==-==-=-=-=-==-=-=-=-=-==-=-



my $result_out:shared=  shift || 'good_proxy.txt';

my $proxies_fl = shift || 'proxy.txt';

my $threads    =  20;

my $DEBUG:shared = 0;

my $rnd = 0;



#=-=-=-=--==-====--=-======-=-=-=-==-====-=-==-=--==-==-=-=-=-==-=-=-=-=-==-=-

# delete dublicates



open (F , '<'.$proxies_fl);

my @input = <F>;

chomp (@input);

close F;

my %out = ();

@input = grep(!$out{$_}++, @input);



#=-=-=-=--==-====--=-======-=-=-=-==-====-=-==-=--==-==-=-=-=-==-=-=-=-=-==-=-



#open (FILE, '<'.$proxies_fl) || die(" -  $proxies_fl not found!\n");

#my @proxy : shared = <FILE>;

my @proxy : shared = @input;

#chomp(@proxy);

#close(FILE);



print ' ~  locaded '.scalar(@proxy)." proxy\n\n";

my $c:shared = 0;

$| = 1;



for(0..$threads) {$trl[$_] = threads->create(\&CheckPr, $_);}

for(@trl) { $_->join; }



print "\n\n ~~ FINISH!\n";

print ' ~~ GOOD: '.$c."\n";



<stdin>;

exit;





sub CheckPr {

     while(@proxy){

        my $p = '127.0.0.1';

        {lock(@proxy);

         if ($rnd) {

             my $seed = rand(scalar(@proxy));

             $p = $proxy[$seed];

             delete($proxy[$seed]);

         } else {

             $p = shift @proxy;

         }

        }

        my $UA = LWP::UserAgent->new;

        $UA->timeout(10);

        $UA->proxy(['http'] => 'http://'.$p);

        my $test = $UA->get('http://pda.vkontakte.ru/')->content;

        if ($test =~ /vkontakte/i) {

                 print ' +  '.$p."\n"; $c++;

                 &s2f($result_out,$p);

                 &s2f('GOOD_'.$p.'.html',$test) if ($DEBUG == 1);

         } else {

                 print ' -  '.$p."\n";

                 &s2f('BAD_'.$p.'.html',$test) if ($DEBUG == 1);

        }

     }

}





#=-=-=-=--==-====--=-======-=-=-=-==-====-=-==-=--==-==-=-=-=-==-=-=-=-=-==-=-



# save file

sub s2f {

    $_ = $_[0];

    my $f = ~s/://g;

    $f = $_;

    open(myFILE,">>$f") || die "error: $!";

    print myFILE $_[1]."\n";

    close(myFILE);

} 



#=-=-=-=--==-====--=-======-=-=-=-==-====-=-==-=--==-==-=-=-=-==-=-=-=-=-==-=-