
08.09.2008, 01:37
|
|
Участник форума
Регистрация: 20.12.2007
Сообщений: 295
Провел на форуме: 1777055
Репутация:
347
|
|
Может кому-то будет нужен 
Скрипт на перле качает фотки с xuk.ru
Код:
#Скрипт закачивает фотки с xuk.ru ;)
use LWP;
use strict;
my $n = shift;
my $html = '';
if(defined($n))
{
$html = "$n.html";
$n = " - $n";
}
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
my $newdir = sprintf "%02u-%02u-%04u$n",$mday,$mon+1,$year+1900;
mkdir $newdir || die 'cannot create directory';
chdir $newdir;
my $ua = LWP::UserAgent->new;
my $res = $ua->get("http://xuk.ru/$html");
die 'cannot connect' unless $res->is_success;
my @main = split /\x0D\x0A/, $res->content;
my @girl_url;
foreach (@main)
{
if(/vid-1\.html/)
{
push @girl_url, $& if /http:\/\/xuk\.ru\/.*vid-1\.html/;
}
}
foreach (@girl_url)
{
my $folder = substr $&, 1, -11 if /\/[\w-]*\/vid-1.html/;
print "FOLDER: $folder\n";
mkdir $folder || die 'cannot create directory';
$res = $ua->get($_);
unless($res->is_success)
{
warn "cannot connect\n";
next
}
my @vid = split /\x0D\x0A/, $res->content;
my @foto_url;
foreach(@vid)
{
if(/<img alt="Эротика/)
{
push @foto_url, $& if /http:\/\/pic\.xuk\.ru\/files.*\.jpg/;
}
}
foreach (@foto_url)
{
my $filename = substr $&, 1 if /\/[\w-\(\)\.]*\.jpg/;
print "\tFILE: $filename\n";
$ua->get($_, ':content_file' => "$folder/$filename");
}
}
chdir '..';
|
|
|