[Perl Tk] FTP Manager 0.2

BigBear · Abril 22, 2012, 12:05:44 AM

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

Código: perl


#!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 ?

[Perl Tk] FTP Manager 0.2

BigBear

Abril 22, 2012, 12:05:44 AM Ultima modificación: Marzo 14, 2015, 10:19:55 AM por Expermicid