send
Grupo de Telegram
play_arrow
Este sitio utiliza cookies propias y de terceros. Si continúa navegando consideramos que acepta el uso de cookies. OK Más Información.

[Perl Tk] Simple Downloader 0.1

  • 0 Respuestas
  • 959 Vistas

0 Usuarios y 1 Visitante están viendo este tema.

Desconectado BigBear

  • *
  • Underc0der
  • Mensajes: 544
  • Actividad:
    0%
  • Reputación 3
    • Ver Perfil
« en: Mayo 05, 2012, 09:18:33 pm »
Version Tk de un simple programa en Perl para bajar archivos.

Una imagen



El codigo

Código: Perl
  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 You are not allowed to view links. Register or Login(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, -You are not allowed to view links. Register or Login => 20 );
  37. my $pre = $dron->Entry(
  38.     -width      => 45,
  39.     -background => $color_fondo,
  40.     -foreground => $color_texto
  41. )->place( -x => 60, -You are not allowed to view links. Register or Login => 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, -You are not allowed to view links. Register or Login => 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.             You are not allowed to view links. Register or Login true;
  87.         }
  88.     }
  89. }
  90.  
  91. #The End ?
  92.  
  93.  
« Última modificación: Marzo 14, 2015, 10:21:06 am por Expermicid »

 

¿Te gustó el post? COMPARTILO!



Tutorial perl desde cero By: Black Poision & Painboy

Iniciado por ProcessKill

Respuestas: 2
Vistas: 2856
Último mensaje Septiembre 02, 2011, 09:43:36 pm
por blozzter
[Perl] Verificando si es root para correr un script

Iniciado por c1st

Respuestas: 1
Vistas: 1327
Último mensaje Octubre 07, 2012, 06:01:39 pm
por ANTRAX
[Perl] Search in google for scan SQLI

Iniciado por BigBear

Respuestas: 0
Vistas: 1080
Último mensaje Julio 03, 2011, 09:49:49 pm
por BigBear
[Uniscan] Scanner de vulnerabilidades WEB hecho en Perl

Iniciado por tar3kw0rm3d

Respuestas: 0
Vistas: 1474
Último mensaje Junio 02, 2013, 08:01:28 pm
por tar3kw0rm3d
[Perl] Counter Strike 1.6 Servers List

Iniciado por BigBear

Respuestas: 0
Vistas: 1014
Último mensaje Noviembre 12, 2012, 07:32:11 pm
por BigBear