genom--
17.02.2008, 15:51
в общем типо скриптик писался для хранения базы шеллов и проверки их на валид и пиар
дописал потоки, сортировку по пиару + переработал очистку - конфиг внутри скрипта
reset - обновляет контект
Sort by PR - сортировка по пиару
check & PR all -- проверяет все линки на шеллы и ставит пиар по сайту
save - сохраняет список в файл
clean body - очищает окно проги но не файл
clean - очищает от мусора линки на шеллы
export - экспорт списка для продажи + там еще возможность дампа в файл - по дефолту на рабочий стол в винде
add to base добавление того что у вас в окне к файлу и обновление всего файла с дополнением
сопстна все
извра скриптик с извра кодом =)
#!/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;}
PS скачивайте на сайте в подписи
дописал потоки, сортировку по пиару + переработал очистку - конфиг внутри скрипта
reset - обновляет контект
Sort by PR - сортировка по пиару
check & PR all -- проверяет все линки на шеллы и ставит пиар по сайту
save - сохраняет список в файл
clean body - очищает окно проги но не файл
clean - очищает от мусора линки на шеллы
export - экспорт списка для продажи + там еще возможность дампа в файл - по дефолту на рабочий стол в винде
add to base добавление того что у вас в окне к файлу и обновление всего файла с дополнением
сопстна все
извра скриптик с извра кодом =)
#!/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;}
PS скачивайте на сайте в подписи