Foro de elhacker.net

Programación => Scripting => Mensaje iniciado por: BigBear en 6 Mayo 2012, 02:08 am



Título: [Perl Tk] Simple Downloader 0.1
Publicado por: BigBear en 6 Mayo 2012, 02:08 am
Version Tk de un simple programa en Perl para bajar archivos.

Una imagen

(http://doddyhackman.webcindario.com/images/downperl.jpg)

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.