VPF::Качалка файлов - Форум программистов

chaos

Дата 27.10.2004, 11:30 (ссылка)

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

Загрузка ...

Серийный программист

Профиль
Группа: Завсегдатай
Сообщений: 2979
Регистрация: 7.7.2004
Где: Екатеринбург

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

Всем ЗДРАСТЕ!!!!

Подскажите: хочу написать скрипт каторый будет выкачивать файл с http сервера, не хтмл а допустим гиф
Пример: есть адрес: http://host.ru/image.gif(пример)
как мне этот файл закачать к себе на машинку, средствами перл

Это сообщение отредактировал(а) chaos - 27.10.2004, 11:31

GoodBoy

Дата 27.10.2004, 12:02 (ссылка)

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

Загрузка ...

Главный джедай

Профиль
Группа: Модератор
Сообщений: 3886
Регистрация: 8.1.2003
Где: КМВ

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

что-то наподобе такого...

Код

#!/usr/bin/perl

use Socket;

$file = '/images/pict.gif';
$host = 'www.domain.ru';
$port = 80;
$request="GET $file HTTP/1.0\nHOST: $host:$port\n";

$SIG{ALRM} = sub { die };
$/=undef;
alarm 25;
eval { $text = &http; };
close SOCK;

if ((!$@) and ($text=~/^HTTP\/[^ ]* (\d+)/) and ($1==200)) {
        $text=~/\r?\n\r?\n/s;
        $out = $';
}

open (FL, ">pict.gif");
print FL $out;
close FL;
print "ok\n";

sub http {
        return 'Error 1' if !($addr=gethostbyname($host));
        return 'Error 2' if !(socket(SOCK,PF_INET,SOCK_STREAM,getprotobyname('tcp')));
        return 'Error 3' if !(connect(SOCK,pack('S n a4 x8', PF_INET, 80, $addr)));
        select SOCK;
        $|=1;
        select STDOUT;
        print SOCK $request."\n";
        my @text = <SOCK>;
        return join("", @text);
}

--------------------

Чем дальше в лес, тем толще партизаны...

Цитата(igorold @ 1.5.2016, 17:40

)

Индейцы не обратили внимания на поток беженцев из Европы… Теперь они живут в резервациях.

chaos

Дата 27.10.2004, 13:03 (ссылка)

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

Загрузка ...

Серийный программист

Профиль
Группа: Завсегдатай
Сообщений: 2979
Регистрация: 7.7.2004
Где: Екатеринбург

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

одна проблемка возникла!!!
размеры у файлов получаются разные

(

GoodBoy

Дата 27.10.2004, 13:41 (ссылка)

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

Загрузка ...

Главный джедай

Профиль
Группа: Модератор
Сообщений: 3886
Регистрация: 8.1.2003
Где: КМВ

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

попробуй вот так:

Код

open (FL, ">pict.gif");
binmode FL;
print FL $out;
close FL;

--------------------

Чем дальше в лес, тем толще партизаны...

Цитата(igorold @ 1.5.2016, 17:40

)

Индейцы не обратили внимания на поток беженцев из Европы… Теперь они живут в резервациях.

chaos

Дата 27.10.2004, 14:09 (ссылка)

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

Загрузка ...

Серийный программист

Профиль
Группа: Завсегдатай
Сообщений: 2979
Регистрация: 7.7.2004
Где: Екатеринбург

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

Работает !!!!
СПАСИБО

korob2001

Дата 27.10.2004, 20:47 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2871
Регистрация: 29.12.2002

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

Ещё можно заливать файлы таким способом. Я так делал когда, мне было необходимо залить все модули с www.activestate.com, правда нужно было сначала пропарсить страницу, для того что бы выдернуть оттуда все файлы с разширением .zip. Но сейчас вопрос не в этом.

Вот код:

Код


#!/usr/bin/perl
use strict;
use LWP::Simple;

my $domain = "http://domain.ru";
my $file = "dir/picture.gif";

(my $mirror_file = $file) =~ s/.+\/(\w+\.\w+)$/$1/;

# Далее идёт заливка и проверка того, что файл был успешно залит.
# Она же показывает и размер залитого файла.
if ( mirror("$domain/$file", $mirror_file) ) {
     my $size = sprintf("%.f", ( (stat($mirror_file))[7] / 1024 ));
     print "File $mirror_file successfuly saved. Full size is $size Kb.\n";
} else {
     print "Error\n";
}

Удачи.

Это сообщение отредактировал(а) korob2001 - 27.10.2004, 20:58

--------------------

"Время проходит", - привыкли говорить вы по неверному пониманию.
"Время стоит - проходите вы".

chaos

Дата 29.10.2004, 12:09 (ссылка)

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

Загрузка ...

Серийный программист

Профиль
Группа: Завсегдатай
Сообщений: 2979
Регистрация: 7.7.2004
Где: Екатеринбург

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

Блин возникла проблема!!!!
Если я делаю так:

Код



#!/usr/bin/perl

use Socket;

open (F,"$filename");
while (<F>) {
  chomp;
  general($_);
}

sub general {
  $str=$_[0];
  $file = '/images/'.$str;
  $host = 'www.domain.ru';
  $port = 80;
  $request="GET $file HTTP/1.0\nHOST: $host:$port\n";

  $SIG{ALRM} = sub { die };
  $/=undef;
  alarm 25;
  eval { $text = &http; };
  close SOCK;

  if ((!$@) and ($text=~/^HTTP\/[^ ]* (\d+)/) and ($1==200)) {
       $text=~/\r?\n\r?\n/s;
       $out = $';
  }

  open (FL, ">$str");
  print FL $out;
  close FL;
  print "ok\n";
}

sub http {
       return 'Error 1' if !($addr=gethostbyname($host));
       return 'Error 2' if !(socket(SOCK,PF_INET,SOCK_STREAM,getprotobyname('tcp')));
       return 'Error 3' if !(connect(SOCK,pack('S n a4 x8', PF_INET, 80, $addr)));
       select SOCK;
       $|=1;
       select STDOUT;
       print SOCK $request."\n";
       my @text = <SOCK>;
       return join("", @text);
}

Почемуто качает только один файл. В чем может быть проблемма???

Это сообщение отредактировал(а) chaos - 29.10.2004, 12:19

GoodBoy

Дата 29.10.2004, 12:12 (ссылка)

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

Загрузка ...

Главный джедай

Профиль
Группа: Модератор
Сообщений: 3886
Регистрация: 8.1.2003
Где: КМВ

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

И наверное только самый последний в списке??? Подумай вот над этой строкой:

Код

open (FL, ">pict.gif");

--------------------

Чем дальше в лес, тем толще партизаны...

Цитата(igorold @ 1.5.2016, 17:40

)

Индейцы не обратили внимания на поток беженцев из Европы… Теперь они живут в резервациях.

chaos

Дата 29.10.2004, 12:18 (ссылка)

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

Загрузка ...

Серийный программист

Профиль
Группа: Завсегдатай
Сообщений: 2979
Регистрация: 7.7.2004
Где: Екатеринбург

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

Цитата(GoodBoy @ 29.10.2004, 12:12)

И наверное только самый последний в списке??? Подумай вот над этой строкой:

Код

open (FL, ">pict.gif");

не здесь все хорошо, просто забыл исправить

chaos

Дата 1.11.2004, 12:11 (ссылка)

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

Загрузка ...

Серийный программист

Профиль
Группа: Завсегдатай
Сообщений: 2979
Регистрация: 7.7.2004
Где: Екатеринбург

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

блин проблема все продолжается!!!
прога почемуто качает файлы с одним и тем же содержимым если я делаю вот так

Код


foreach  (@str) {
  chomp;
  gener($_);
}

а если я делаю :

Код


gener('filename1');
gener('filename2');
gener('filename3');
gener('filename4');

Все отлично почему так????
Текст проги:

Код


#!/usr/bin/perl 
use Socket;

my $lst_file='drweb32.lst';

gener($lst_file);   #качаем лст-файл
$/="\n";

#парсим лст-файл
open(F,"<$lst_file") || die $!;
open (FF,">parse$lst_file") || die $!;
NEX: while (<F>) {
  next NEX if /\[\d+\]/;
  s/(.+)\,.*/$1/;
  s/^.?(.+)/$1/;
  s/<.+>(.+)/$1/;
  s/\|.+//;
  s/(.+)\\(.+\.\w+)/$2/;
  next NEX if /\*/g;
  print FF;
}
close FF;
close F;

#Качаем файлы имена каторых содератся в лст-файле
open (F,"<parse$lst_file");
@str = <F>;
close F;
foreach  (@str) {
  chomp;
  gener($_);
}

############ПРОЦЕДУРЫ ОТВЕЧАЮЩИЕ ЗА СКАЧИВАНИЕ АЙЛОВ#########
sub gener {
  $fn=$_[0];
  $file = '/free/windows/'.$fn;
  $host = 'updates.drweb.ru'; #'10.59.1.40';
  $port = 80;
  $request="GET $file HTTP/1.0\nHOST: $host:$port\n";
  $/=undef;

  eval { $text = &http; };
  close SOCK;

  if ((!$@) and ($text=~/^HTTP\/[^ ]* (\d+)/) and ($1==200)) {
    $text=~/\r?\n\r?\n/s;
    $out = $';
  }

  open (FL, ">$fn");
  binmode FL;
  print FL $out;
  close FL;
  print "$fn ok\n";
}
#---------------------------------------------------------------------------------------------------------------------
sub http {
  return 'Error 1' if !($addr=gethostbyname($host));
  return 'Error 2' if !(socket(SOCK,PF_INET,SOCK_STREAM,getprotobyname('tcp')));
  return 'Error 3' if !(connect(SOCK,pack('S n a4 x8', PF_INET, 80, $addr)));
  select SOCK;
  $|=1;
  select STDOUT;
  print SOCK $request."\n";
  my @text = <SOCK>;
  return join("", @text);
} 
#############################################################

korob2001

Дата 1.11.2004, 15:06 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2871
Регистрация: 29.12.2002

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

Обрати внимание на эту строку из вышеприведённого мной скрипта:

Код


(my $mirror_file = $file) =~ s/.+\/(\w+\.\w+)$/$1/;

--------------------

"Время проходит", - привыкли говорить вы по неверному пониманию.
"Время стоит - проходите вы".

chaos

Дата 16.11.2004, 07:34 (ссылка)

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

Загрузка ...

Серийный программист

Профиль
Группа: Завсегдатай
Сообщений: 2979
Регистрация: 7.7.2004
Где: Екатеринбург

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

Кстати попробовал функцию get из LWP, довольно таки не плоха она справляется с закачкой файлов

korob2001

Дата 16.11.2004, 23:41 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2871
Регистрация: 29.12.2002

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

Пробуй не get, а mirror. Выше, я написал как.

Это сообщение отредактировал(а) korob2001 - 16.11.2004, 23:42

--------------------

"Время проходит", - привыкли говорить вы по неверному пониманию.
"Время стоит - проходите вы".

anest

Дата 17.6.2005, 06:10 (ссылка)

(голосов: 0)

Загрузка ...

Unregistered

подскажите плыз
а как пропарсить страницу .html с которой есть ссылки на другие страницы (а с них еще и тд в цикле но страницы только в заданном домене) и собрать с них все ссылки на .zip файлы и скинуть их все в файл list.lst к примеру?
smile

korob2001

Дата 17.6.2005, 06:29 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2871
Регистрация: 29.12.2002

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

anest - а причём здесь эта тема???

М	Один топик, один вопрос

Это сообщение отредактировал(а) korob2001 - 17.6.2005, 06:30

--------------------

"Время проходит", - привыкли говорить вы по неверному пониманию.
"Время стоит - проходите вы".

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