Version Tk de un simple programa en Perl para bajar archivos.
Una imagen
(http://doddyhackman.webcindario.com/images/downperl.jpg)
El codigo
#!usr/bin/perl
#Simple downloader 0.1
#Version Tk
#Coded By Doddy H
use Tk;
use Tk::Dialog;
use LWP::UserAgent;
use URI
::Split qw(uri_split
);
my $color_fondo = "black";
my $color_texto = "green";
my $nave = LWP::UserAgent->new;
$nave->agent(
"Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
);
$nave->timeout(20);
if ( $^O eq 'MSWin32' ) {
use Win32::Console;
Win32::Console::Free();
}
my $dron =
MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
$dron->geometry("430x70+20+20");
$dron->resizable( 0, 0 );
$dron->title("Simple Downloader 0.1 || [+] Status : <None>");
$dron->Label(
-text => "URL : ",
-font => "Impact",
-background => $color_fondo,
-foreground => $color_texto
)->place( -x
=> 20, -y => 20 ); my $pre = $dron->Entry(
-width => 45,
-background => $color_fondo,
-foreground => $color_texto
)->place( -x
=> 60, -y => 27 ); $dron->Button(
-command => \&now,
-text => "Download",
-width => 10,
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->place( -x
=> 340, -y => 25 );
MainLoop;
sub now {
my ( $scheme, $auth, $path, $query, $frag ) = uri_split( $pre->get );
$dron->title("Simple Downloader 0.1 || [+] Status : Downloading..");
if ( $path =~ /(.*)\/(.*)$/ ) {
my $file = $2;
if ( download( $pre->get, $file ) ) {
$dron->Dialog(
-title => "OK",
-buttons => ["OK"],
-text => "File downloaded",
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->Show();
}
else {
$dron->Dialog(
-title => "Error",
-buttons => ["OK"],
-text => "Error",
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->Show();
}
}
$dron->title("Simple Downloader 0.1 || [+] Status : <None>");
}
sub download {
if ( $nave->mirror( $_[0], $_[1] ) ) {
if ( -f $_[1] ) {
}
}
}
#The End ?