VPF::Код. Скачивания архива Mail.ru Агента

nikjig7948

Дата 2.5.2013, 21:31 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 2
Регистрация: 2.5.2013

Репутация: нет
Всего: нет

Доброго времени суток, форумчане-программисты.

У меня есть такой код, функция которого скачивание архива Mail.ru агенте. Но, этот код не доработанный. То есть, скачаивается все подряд. Можно ли изменить его так, чтобы можно было указать переписку с конкретным e-mail'ом и указать время.

Заранее благодарю. Спасибо за внимание.

Код


#!/usr/bin/perl

use LWP::UserAgent;
use HTTP::Cookies;

################# Config ###############

my $email = '[email protected]';
my $pass = 'your_password';

############### End Config ##############

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);

sub logg
{
my ($data, $file) = @_;
open(OUT, "> ".$file);
print OUT "$data\n";
close(OUT);
}

sub authorization
{
my ($email, $pass) = @_;

my ($login, $domain) = $email =~ /^(.+?)@(.+?)$/;

$cookie_jar->clear();

my $ex = $ua->post('http://win.mail.ru/cgi-bin/auth', ['Login' => $login, 'Domain' => $domain, 'Password' => $pass]);

if ($ex->headers_as_string() =~/Set-Cookie: Mpop=/)
{
return 1;
}
}

sub get_users
{
my $ex = $ua->post('http://e.mail.ru/cgi-bin/mrimhistory?', ['mrim_hist_password' => $pass, 'PasswordAsk' => 'on'], Referer => 'http://e.mail.ru/cgi-bin/mrimhistory')->content();

my @allusers = $ex =~ /class=letavtor title=\"(.+?)\"/g;

while(1)
{
my ($nextpage) = $ex =~ /<a href=\"(.+?)\" id=\"nextbut\">/;
last if (!$nextpage);

$ex = $ua->get('http://e.mail.ru/cgi-bin/'.$nextpage)->content();
my @users = $ex =~ /class=letavtor title=\"(.+?)\"/g;

foreach (@users)
{
push(@allusers, $_);
}

}

return @allusers;
}

sub get_messages
{
my ($user) = @_;
my $i = 0;
my $ex = $ua->get('http://e.mail.ru/cgi-bin/mrimhistory?mode=1&email='.$user)->content();

my @allmess = $ex =~/<td class=\"letavtor\"><nobr><span.+?>(.+?)<nobr><\/span><\/td>.+?<td class=lettem>(.+?)<\/td>.+?<td class=dat title=\"(.+?)\">/gs;


while(1)
{
my ($nextpage) = $ex =~ /<a href=\"(.+?)\" id=\"nextbut\">/;
last if (!$nextpage);

$ex = $ua->get('http://e.mail.ru/cgi-bin/'.$nextpage)->content();
my @mess = $ex =~/<td class=\"letavtor\"><nobr><span.+?>(.+?)<nobr><\/span><\/td>.+?<td class=lettem>(.+?)<\/td>.+?<td class=dat title=\"(.+?)\">/gs;

foreach (@mess)
{
push(@allmess, $_);
}

print "\t\tpage:".$i++."\n";


}

my $arhive = '';

while(@allmess)
{
my $data = pop(@allmess);
my $message = pop(@allmess);
my $name = pop(@allmess);

$arhive .= $name.' : '.$data."<br>\r\n".$message."<br><br>\r\n\r\n";

}

logg($arhive, $user.'.html');

}

authorization($email, $pass);
my @allusers = get_users();
print "Users: ".scalar(@allusers)."\n\n\n";

foreach (@allusers)
{
print "\t".$_."\n";
get_messages($_);

}

Добавлено через 2 минуты
Кстати, новичкам или дубам вроде меня подсказка. Для того, чтобы попытаться скачать архив надо скачать и установить ActivePerl-5.16.3.1603-MSWin32-x86-296746

nikjig7948

Дата 2.5.2013, 21:49 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 2
Регистрация: 2.5.2013

Репутация: нет
Всего: нет

Алгоритм такой: что скрипт сохраняет не по волшебству, а как будто вы заходите в браузере в файл> сохранить страницу, только скрипт сам листает и сам сохраняет в один файл !

1) Неплохо бы модернизировать скрипт, что бы он сохранял например 10 страниц с последними сообщениями; или вообще чтобы можно было скачать страницы например с 20 по 50

2) как исключить/скачать сразу несколько контактов? (в теме был пример на только на один контакт)

Krator

Дата 28.10.2014, 07:25 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 1
Регистрация: 28.10.2014

Репутация: нет
Всего: нет

Уже не работает, раньше работал. Что случилось? как исправить?

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Perl: разработка для Web \| Следующая тема »