Version Tk de un cliente FTP que hice en Perl
Las opciones que tiene son
- Listado de archivos en un directorio
- Borrar archivos y directorios
- Crear directorios nuevos
- Renombrar
- Descargar y subir archivos
Una imagen
El codigo del programa
#!usr/bin/perl
#FTP Manager 0.2
#Version Tk
#Coded By Doddy H
use Tk;
use Tk::FileSelect;
use Cwd;
use Net::FTP;
if ( $^O eq 'MSWin32' ) {
use Win32::Console;
Win32::Console::Free();
}
my $color_fondo = "black";
my $color_texto = "cyan";
my $navedos =
MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
$navedos->title("FTP Manager 0.2");
$navedos->geometry("218x150+20+20");
$navedos->resizable( 0, 0 );
$navedos->Label(
-text => "Host : ",
-font => "Impact1",
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 10, -y => 10 );
my $host = $navedos->Entry(
-width => 23,
-text => "localhost",
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 60, -y => 13 );
$navedos->Label(
-text => "User : ",
-font => "Impact1",
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 10, -y => 40 );
my $user = $navedos->Entry(
-width => 23,
-text => "doddy",
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 60, -y => 43 );
$navedos->Label(
-text => "Pass : ",
-font => "Impact1",
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 10, -y => 70 );
my $pass = $navedos->Entry(
-width => 23,
-text => "doddy",
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 60, -y => 73 );
$navedos->Button(
-text => "Connect",
-width => 13,
-command => \&now,
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->place( -x => 60, -y => 110 );
MainLoop;
sub now {
my $host = $host->get;
my $user = $user->get;
my $pass = $pass->get;
my $socket = Net::FTP->new($host);
if ( $socket->login( $user, $pass ) ) {
$navedos->destroy;
my $mandos = MainWindow->new(
-background => $color_fondo,
-foreground => $color_texto
);
$mandos->title("FTP Manager 0.2 || Coded By Doddy H");
$mandos->geometry("565x335+20+20");
$mandos->resizable( 0, 0 );
$menul = $mandos->Frame(
-relief => "sunken",
-bd => 1,
-background => $color_fondo,
-foreground => $color_texto
);
my $menulnow = $menul->Menubutton(
-text => "Options",
-underline => 1,
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->pack( -side => "left" );
my $aboutnow = $menul->Menubutton(
-text => "About",
-underline => 1,
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->pack( -side => "left" );
my $exitnow = $menul->Menubutton(
-text => "Exit",
-underline => 1,
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->pack( -side => "left" );
$menul->pack( -side => "top", -fill => "x" );
$menulnow->command(
-label => "Delete File",
-background => $color_fondo,
-foreground => $color_texto,
-command => \&delnow
);
$menulnow->command(
-label => "Delete Directory",
-background => $color_fondo,
-foreground => $color_texto,
-command => \&deldirnow
);
$menulnow->command(
-label => "Make Directory",
-background => $color_fondo,
-foreground => $color_texto,
-command => \&makedirnow
);
$menulnow->command(
-label => "Rename",
-background => $color_fondo,
-foreground => $color_texto,
-command => \&renamenow
);
$menulnow->command(
-label => "Download",
-background => $color_fondo,
-foreground => $color_texto,
-command => \&downloadnow
);
$menulnow->command(
-label => "Upload",
-background => $color_fondo,
-foreground => $color_texto,
-command => \&updatenow
);
$aboutnow->command(
-label => "About",
-background => $color_fondo,
-foreground => $color_texto,
-command => \&aboutnownow
);
$exitnow->command(
-label => "Exit",
-background => $color_fondo,
-foreground => $color_texto,
-command => \&exitnow
);
$mandos->Label(
-text => "Directory : ",
-font => "Impact1",
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 23, -y => 40 );
my $actual = $mandos->Entry(
-text => "/",
-width => 60,
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 105, -y => 43 );
$mandos->Button(
-width => 8,
-text => "Enter",
-command => \&dirs,
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->place( -x => 480, -y => 43 );
$mandos->Label(
-text => "Directory",
-font => "Impact1",
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 130, -y => 90 );
$mandos->Label(
-text => "Files",
-font => "Impact1",
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 350, -y => 90 );
my $dir_now = $mandos->Listbox(
-width => 25,
-height => 13,
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 88, -y => 130 );
my $files_now = $mandos->Listbox(
-width => 25,
-height => 13,
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 300, -y => 130 );
sub exitnow {
$socket->close();
exit(1);
}
sub aboutnownow {
$mandos->Dialog(
-title => "About",
-buttons => ["OK"],
-text => "Coded By Doddy H",
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->Show();
}
sub dirs {
$dir_now->delete( "0.0", "end" );
$files_now->delete( "0.0", "end" );
if ( my @files = $socket->dir() ) {
my @files_found;
my @dirs_found;
$socket->cwd( $actual->get );
for my $fil (@files) {
my @to = split( " ", $fil );
my ( $dir, $file ) = @to[ 0, 8 ];
if ( $dir =~ /^d/ ) {
$dir_now->insert( "end", $file );
}
else {
$files_now->insert( "end", $file );
}
}
}
}
sub delnow {
my $ventdos = MainWindow->new(
-background => $color_fondo,
-foreground => $color_texto
);
$ventdos->geometry("260x80+20+20");
$ventdos->title("Delete File");
$ventdos->resizable( 0, 0 );
$ventdos->Label(
-text => "File : ",
-font => "Impact",
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 20, -y => 20 );
my $filechau = $ventdos->Entry(
-width => 20,
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 60, -y => 26 );
$ventdos->Button(
-width => 6,
-text => "Delete",
-command => \&delnowdos,
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->place( -x => 190, -y => 25 );
sub delnowdos {
if ( $socket->delete( $filechau->get ) ) {
$mandos->Dialog(
-title => "Deleted",
-buttons => ["OK"],
-text => "File Deleted",
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->Show();
}
else {
$mandos->Dialog(
-title => "Error",
-buttons => ["OK"],
-text => "Error",
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->Show();
}
}
}
sub deldirnow {
my $venttres = MainWindow->new(
-background => $color_fondo,
-foreground => $color_texto
);
$venttres->geometry("300x80+20+20");
$venttres->title("Delete Directory");
$venttres->resizable( 0, 0 );
$venttres->Label(
-text => "Directory : ",
-font => "Impact",
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 20, -y => 20 );
my $dirchau = $venttres->Entry(
-width => 20,
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 99, -y => 26 );
$venttres->Button(
-width => 6,
-text => "Delete",
-command => \&deldirnowdos,
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->place( -x => 230, -y => 25 );
sub deldirnowdos {
if ( $socket->rmdir( $dirchau->get ) ) {
$mandos->Dialog(
-title => "Deleted",
-buttons => ["OK"],
-text => "Directory Deleted",
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->Show();
}
else {
$mandos->Dialog(
-title => "Error",
-buttons => ["OK"],
-text => "Error",
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->Show();
}
}
}
sub makedirnow {
my $ventcuatro = MainWindow->new(
-background => $color_fondo,
-foreground => $color_texto
);
$ventcuatro->geometry("300x80+20+20");
$ventcuatro->title("Make Directory");
$ventcuatro->resizable( 0, 0 );
$ventcuatro->Label(
-text => "Directory : ",
-font => "Impact",
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 20, -y => 20 );
my $dirnow = $ventcuatro->Entry(
-width => 20,
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 99, -y => 26 );
$ventcuatro->Button(
-width => 6,
-text => "Make",
-command => \&makedirnowdos,
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->place( -x => 230, -y => 25 );
sub makedirnowdos {
if ( $socket->mkdir( $dirnow->get ) ) {
$mandos->Dialog(
-title => "Ok",
-buttons => ["OK"],
-text => "Ok",
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->Show();
}
else {
$mandos->Dialog(
-title => "Error",
-buttons => ["OK"],
-text => "Error",
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->Show();
}
}
}
sub renamenow {
my $ventcinco = MainWindow->new(
-background => $color_fondo,
-foreground => $color_texto
);
$ventcinco->geometry("440x80+20+20");
$ventcinco->title("Rename");
$ventcinco->resizable( 0, 0 );
$ventcinco->Label(
-text => "Name : ",
-font => "Impact",
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 20, -y => 20 );
my $unonow = $ventcinco->Entry(
-width => 20,
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 74, -y => 26 );
$ventcinco->Label(
-text => "To : ",
-font => "Impact",
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 210, -y => 20 );
my $dosnow = $ventcinco->Entry(
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 240, -y => 26 );
$ventcinco->Button(
-width => 6,
-text => "Rename",
-command => \&renamenowdos,
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->place( -x => 372, -y => 26 );
sub renamenowdos {
if ( $socket->rename( $unonow->get, $dosnow->get ) ) {
$mandos->Dialog(
-title => "Ok",
-buttons => ["OK"],
-text => "Ok",
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->Show();
}
else {
$mandos->Dialog(
-title => "Error",
-buttons => ["OK"],
-text => "Error",
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->Show();
}
}
}
sub updatenow {
my $ventseis = MainWindow->new(
-background => $color_fondo,
-foreground => $color_texto
);
$ventseis->geometry("440x80+20+20");
$ventseis->title("Upload");
$ventseis->resizable( 0, 0 );
$ventseis->Label(
-text => "File : ",
-font => "Impact",
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 20, -y => 20 );
my $filenow = $ventseis->Entry(
-width => 40,
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 60, -y => 26 );
$ventseis->Button(
-width => 8,
-text => "Browse",
-command => \&bronow,
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->place( -x => 310, -y => 26 );
$ventseis->Button(
-width => 8,
-text => "Upload",
-command => \&updatenowdos,
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->place( -x => 365, -y => 26 );
sub bronow {
$browse = $ventseis->FileSelect( -directory => getcwd() );
my $file = $browse->Show;
$filenow->configure( -text => $file );
}
sub updatenowdos {
if ( $socket->put( $filenow->get ) ) {
$mandos->Dialog(
-title => "File uploaded",
-buttons => ["OK"],
-text => "Ok",
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->Show();
}
else {
$mandos->Dialog(
-title => "Error",
-buttons => ["OK"],
-text => "Error",
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->Show();
}
}
}
sub downloadnow {
my $ventsiete = MainWindow->new(
-background => $color_fondo,
-foreground => $color_texto
);
$ventsiete->geometry("270x80+20+20");
$ventsiete->title("Downloader");
$ventsiete->resizable( 0, 0 );
$ventsiete->Label(
-text => "File : ",
-font => "Impact",
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 20, -y => 20 );
my $filenownow = $ventsiete->Entry(
-width => 20,
-background => $color_fondo,
-foreground => $color_texto
)->place( -x => 59, -y => 26 );
$ventsiete->Button(
-width => 8,
-text => "Download",
-command => \&downloadnowdos,
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->place( -x => 190, -y => 25 );
sub downloadnowdos {
if ( $socket->get( $filenownow->get ) ) {
$mandos->Dialog(
-title => "File downloaded",
-buttons => ["OK"],
-text => "Ok",
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->Show();
}
else {
$mandos->Dialog(
-title => "Error",
-buttons => ["OK"],
-text => "Error",
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->Show();
}
}
}
}
else {
$mandos->Dialog(
-title => "Error",
-buttons => ["OK"],
-text => "Error",
-background => $color_fondo,
-foreground => $color_texto,
-activebackground => $color_texto
)->Show();
}
}
#The End ?
