elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Rompecabezas de Bitcoin, Medio millón USD en premios


+  Foro de elhacker.net
|-+  Programación
| |-+  Scripting
| | |-+  [Perl Tk] Simple Downloader 0.1
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [Perl Tk] Simple Downloader 0.1  (Leído 1,825 veces)
BigBear


Desconectado Desconectado

Mensajes: 545



Ver Perfil
[Perl Tk] Simple Downloader 0.1
« en: 6 Mayo 2012, 02:08 am »

Version Tk de un simple programa en Perl para bajar archivos.

Una imagen



El codigo

Código
  1. #!usr/bin/perl
  2. #Simple downloader 0.1
  3. #Version Tk
  4. #Coded By Doddy H
  5.  
  6. use Tk;
  7. use Tk::Dialog;
  8. use LWP::UserAgent;
  9. use URI::Split qw(uri_split);
  10.  
  11. my $color_fondo = "black";
  12. my $color_texto = "green";
  13.  
  14. my $nave = LWP::UserAgent->new;
  15. $nave->agent(
  16. "Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
  17. );
  18. $nave->timeout(20);
  19.  
  20. if ( $^O eq 'MSWin32' ) {
  21.    use Win32::Console;
  22.    Win32::Console::Free();
  23. }
  24.  
  25. my $dron =
  26.  MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
  27. $dron->geometry("430x70+20+20");
  28. $dron->resizable( 0, 0 );
  29. $dron->title("Simple Downloader 0.1 || [+] Status : <None>");
  30.  
  31. $dron->Label(
  32.    -text       => "URL : ",
  33.    -font       => "Impact",
  34.    -background => $color_fondo,
  35.    -foreground => $color_texto
  36. )->place( -x => 20, -y => 20 );
  37. my $pre = $dron->Entry(
  38.    -width      => 45,
  39.    -background => $color_fondo,
  40.    -foreground => $color_texto
  41. )->place( -x => 60, -y => 27 );
  42. $dron->Button(
  43.    -command          => \&now,
  44.    -text             => "Download",
  45.    -width            => 10,
  46.    -background       => $color_fondo,
  47.    -foreground       => $color_texto,
  48.    -activebackground => $color_texto
  49. )->place( -x => 340, -y => 25 );
  50.  
  51. MainLoop;
  52.  
  53. sub now {
  54.  
  55.    my ( $scheme, $auth, $path, $query, $frag ) = uri_split( $pre->get );
  56.    $dron->title("Simple Downloader 0.1 || [+] Status : Downloading..");
  57.    if ( $path =~ /(.*)\/(.*)$/ ) {
  58.        my $file = $2;
  59.        if ( download( $pre->get, $file ) ) {
  60.            $dron->Dialog(
  61.                -title            => "OK",
  62.                -buttons          => ["OK"],
  63.                -text             => "File downloaded",
  64.                -background       => $color_fondo,
  65.                -foreground       => $color_texto,
  66.                -activebackground => $color_texto
  67.            )->Show();
  68.        }
  69.        else {
  70.            $dron->Dialog(
  71.                -title            => "Error",
  72.                -buttons          => ["OK"],
  73.                -text             => "Error",
  74.                -background       => $color_fondo,
  75.                -foreground       => $color_texto,
  76.                -activebackground => $color_texto
  77.            )->Show();
  78.        }
  79.    }
  80.    $dron->title("Simple Downloader 0.1 || [+] Status : <None>");
  81. }
  82.  
  83. sub download {
  84.    if ( $nave->mirror( $_[0], $_[1] ) ) {
  85.        if ( -f $_[1] ) {
  86.            return true;
  87.        }
  88.    }
  89. }
  90.  
  91. #The End ?
  92.  
  93.  


En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Videotutorial Crear Downloader Simple « 1 2 »
Programación Visual Basic
k-boy 17 7,927 Último mensaje 30 Octubre 2008, 17:06 pm
por ~~
[Perl] Simple Downloader 0.1
Scripting
BigBear 0 1,662 Último mensaje 6 Mayo 2012, 02:08 am
por BigBear
[Perl] MP3 Downloader 0.1
Scripting
BigBear 2 1,940 Último mensaje 27 Noviembre 2012, 16:18 pm
por BigBear
[Perl] PasteBin Downloader 0.1
Scripting
BigBear 0 1,879 Último mensaje 20 Julio 2013, 23:58 pm
por BigBear
Simple Mass Downloader: descarga todos los enlaces de una web en Chrome
Noticias
wolfbcn 0 1,150 Último mensaje 14 Enero 2019, 21:27 pm
por wolfbcn
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines