#!/usr/bin/perl    ################## shell<->commander V2 #################  # coded by genom--  # специально для antichat.ru - ачат мы любим тебя - держись.  # NO SPLoA, NO WORLD !!!!!  # Спасибо друзьям,одептам и моей маме.  ################## волт 13. 2007 г.#################    use Tk;  use Tk::ROText;  use Tk::Frame;  use Tk::LabFrame;  use Tk::BrowseEntry;  use Tk::DialogBox;  use LWP::UserAgent;  use threads;  use threads::shared;  my $a:shared;  open as,'<shell.txt' or open as,'>shell.txt';close as;     my $ua = LWP::UserAgent->new;  $ua->timeout(5);  $ua->agent('Opera/9.00 (Windows NT 5.1; U; en)');  $ua->requests_redirectable(0);    $col='#330000';   # цвет фона -- вынес в переменную чтобы могли поменять если комуто не понравится  $tes='red';  # цвет шрифта в лейблах =)  $bgform='#cccc99';  # цвет фона  на текстовых полях  $focofo='#006600'; # цвет шрифта в формах   $butcol='#66cc33'; # цвет кнопок   $ff='{Tahoma} 7 bold'; # шрифт   $name='shell.txt'; # имя файла с бд.  $dum='C:\Documents and Settings\All Users\Рабочий стол\dump.txt'; # путь для дампа   $thr=3; # количество потоков     $typak=new MainWindow(title=>"[shell<-->commander] v2 - Private edition - only for my friends",-bg=>$col);  $typak->geometry('1015x500+0+190');  $typak->resizable(0,0);    $knp=$typak->LabFrame(-label=>'Commands',-bg=>$col,-foreground=>$tes)->pack();  $zone=$typak->Frame(-bg=>$col,-foreground=>$tes)->pack();  $knp->Button(-text=>'RESET',-width=>'6',-font=>$ff,-command=>\&reset,-background=>$butcol)->pack(-side=>'left');  $knp->Button(-text=>'Sort by PR',-width=>'8',-font=>$ff,-command=>\sub{prsrt(split(/\n/,$acc->Contents))},-background=>$butcol)->pack(-side=>'left');  $knp->Button(-text=>'Check & PR all',-width=>'14',-font=>$ff,-command=>\sub{$a=0;@am=split(/\n/,$acc->Contents);$a++foreach@am;for(1..$thr){threads->create(\&do);}},-background=>$butcol)->pack(-side=>'left');  $knp->Button(-text=>'Save',-width=>'4',-font=>$ff,-command=>\&save,-background=>$butcol)->pack(-side=>'left');  $knp->Button(-text=>'Clean body',-width=>'10',-font=>$ff,-command=>\&cl,-background=>$butcol)->pack(-side=>'left');  $knp->Button(-text=>'Clean',-width=>'4',-font=>$ff,-command=>\&clean,-background=>$butcol)->pack(-side=>'left');  $knp->Button(-text=>'Export',-width=>'6',-font=>$ff,-command=>\&exp,-background=>$butcol)->pack(-side=>'left');  $knp->Button(-text=>'Add to base',-width=>'10',-font=>$ff,-command=>[\&save,'ad'],-background=>$butcol)->pack(-side=>'left');  $acc=$zone->Scrolled('Text',-scrollbars=>'se',-font=>'{Tahoma} 8 bold',-height=>33,-width=>145,-background=>$bgform,-foreground=>$focofo)->pack(-side=>'left');  &ins;  MainLoop;    sub save{chomp($x=$acc->Contents);open asd,">$name" and print asd$x if@_[0]ne'ad';open asd,">>$name" and print asd "\n$x" if@_[0]eq'ad';close asd;&cl;&ins;}  sub cl{$acc->delete('1.0','end')}  sub ins{open asd,"<$name";$acc->insert('end',$_)while<asd>;close asd;}  sub clean{foreach(split(/\n/,$acc->Contents)){$acc->delete('1.0','2.0');$acc->insert('end',"$1\n")if~/(http:\/\/[^ ]*)/}}  sub reset{&cl;&ins;}  sub exp{my $itog;foreach(split(/\n/,$acc->Contents)){$itog.="$1 $2\n" if~/(http:\/\/[^ \/]*)[^ ]*(.*)/}  my $bl=$typak->DialogBox(-title   => 'Export....',-buttons => ["OK"]);  $bl->geometry('400x410');$exp=$bl->Scrolled('Text',-scrollbars => 'e', -height=>25, -width=>75)->pack();  $exp->insert('end',$itog);$bl->Button(-text=>'Dump',-width =>'6',-font =>$ff,-background=>$butcol,-command=>\sub{open spl,">".$dum;print spl $exp->Contents;close spl;})->pack();$bl->Show();$bl->destroy;}  sub do{while($a>0){$a-- and $sel=@am[$a];$it=ch($&) if $sel=~/http:\/\/[^ \n]*/;  $it.=' '.pr($&) if $sel=~/http:\/\/[^ \n\/]*/;chomp($zi=$acc->Contents);chomp($sel);$zi=~s|$sel|$sel  $it|;&cl;  $acc->insert('end',$zi);}}  sub ch{if($ua->head(@_[0])->as_string=~/200|401/){return '[OK]';}  elsif($ua->head(@_[0])->as_string=~/500/){return 'Bad connect...';}else{return'[BAD]';}}  sub pr{$k=@_[0];  if($ua->post("http://page-rank.org.ua/index.php",{'UrlList'=>$k,'CSV'=>'on'})->as_string=~/$k"[^\n]*/){  my $pr=$&;$pr=~s/$k",/PR=/;$pr=~s/PR=-1/PR=0/ig;return $pr;}else{return ' BAd pR';}}  sub prsrt{undef@st;for($w=10;$w>=0;$w--){foreach$a(@_){push @st=>"$a\n" if $a=~/PR=$w/;}}  foreach$a(@_){push@st=>"$a\n"if$a=~/PR=/ ne 1;}$acc->delete('1.0','end');$acc->insert('end',$_)foreach@st;}