Upload de múltiplos arquivos para Imageshack.us

Publicado por Yves Junqueira Marques Teixeira 07/01/2005

[ Hits: 7.512 ]

Download imageshack_upload.pl




Esse script automatiza o envio de imagens para o serviço gratuito imageshack.us.
Facilita muito a vida de quem tem dezenas de foto pra compartilhar mas tem preguiça de enviar uma foto de cada vez.
Peço por favor não abusar do serviço e sempre que possível visitar as propagandas lá do site deles. Ou, melhor ainda, fazer uma doação pra eles, usando paypal. Sejam conscientes!

  



Esconder código-fonte

#!/usr/bin/perl -w
#######################################################
# imageshack_upload.pl
# - Yves Junqueira, Jan/2005
# Script para enviar diversas imagens para o serviço
# imageshack.us
# Favor não abusar! Contribua com alguns cliques nas
# propagandas daquele site.
#######################################################
# Utilização:
#
#    $ perl imageshack_upload.pl vol.jpg 
#      Enviando vol.jpg... Feito.
#      IMAGEM: http://img119.exs.cx/img119/7908/vol3jp.jpg
#
use strict;
use WWW::Mechanize;

my $url = "http://www.imageshack.us/";
my $verb = 0;

die "Uso: $0 <arquivo1> [arquivo2] ... [arquivoN]" unless @ARGV > 0;
my $mech = WWW::Mechanize->new();
$mech->agent_alias("Linux Mozilla");
$mech->get($url);
 
foreach (@ARGV) {
print "Enviando $_... ";
my $r = $mech->submit_form(
   form_number => 1,
   fields  => { "fileupload" => $_ },
   );
($mech->success) ? print "Feito.\n" : 
   warn $mech->response->status_line;
my $l = image_link($r);

print "IMAGEM: $l\n";
$mech->back;
}

sub image_link {
  my $r = shift;
  my $c = $r->content;

if ($verb == 1) { print "\n------------\n$c\n------------\n"; }
  if ($c =~ m{Here is a direct link to your image\.<br />\s+<textarea cols="100" rows="1" name="select" onClick='highlight\(this\);'>([^>]*)</text}s) {
return $1;
  }
  die "Resposta desconhecida\n---------------------------\n$c\n";
}

Scripts recomendados

HAT Googler

Admin Finder

Avisar por e-mail se o IP da conexão ADSL mudar

Burlando o "Protetor de links" INVERTIDO para download grátis

Redtube video download


  

Comentários
[1] Comentário enviado por juliansoares em 16/02/2012 - 11:00h

esta dando esse erro no script

Can't locate WWW/Mechanize.pm in @INC (@INC contains: /etc/perl /usr/local/lib/perl/5.14.2 /usr/local/share/perl/5.14.2 /usr/lib/perl5 /usr/share/perl5 /usr/lib/perl/5.14 /usr/share/perl/5.14 /usr/local/lib/site_perl .) at imageshack_upload.pl line 17.
BEGIN failed--compilation aborted at imageshack_upload.pl line 17.


Contribuir com comentário




Patrocínio

Site hospedado pelo provedor RedeHost.
Linux banner

Destaques

Artigos

Dicas

Tópicos

Top 10 do mês

Scripts