elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Únete al Grupo Steam elhacker.NET


+  Foro de elhacker.net
|-+  Programación
| |-+  Scripting
| | |-+  [Perl Tk] FTP Manager 0.2
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [Perl Tk] FTP Manager 0.2  (Leído 1,673 veces)
BigBear


Desconectado Desconectado

Mensajes: 545



Ver Perfil
[Perl Tk] FTP Manager 0.2
« en: 22 Abril 2012, 05:03 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
  1. #!usr/bin/perl
  2. #FTP Manager 0.2
  3. #Version Tk
  4. #Coded By Doddy H
  5.  
  6. use Tk;
  7. use Tk::FileSelect;
  8. use Cwd;
  9. use Net::FTP;
  10.  
  11. if ( $^O eq 'MSWin32' ) {
  12.    use Win32::Console;
  13.    Win32::Console::Free();
  14. }
  15.  
  16. my $color_fondo = "black";
  17. my $color_texto = "cyan";
  18.  
  19. my $navedos =
  20.  MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
  21.  
  22. $navedos->title("FTP Manager 0.2");
  23. $navedos->geometry("218x150+20+20");
  24. $navedos->resizable( 0, 0 );
  25.  
  26. $navedos->Label(
  27.    -text       => "Host : ",
  28.    -font       => "Impact1",
  29.    -background => $color_fondo,
  30.    -foreground => $color_texto
  31. )->place( -x => 10, -y => 10 );
  32. my $host = $navedos->Entry(
  33.    -width      => 23,
  34.    -text       => "localhost",
  35.    -background => $color_fondo,
  36.    -foreground => $color_texto
  37. )->place( -x => 60, -y => 13 );
  38.  
  39. $navedos->Label(
  40.    -text       => "User : ",
  41.    -font       => "Impact1",
  42.    -background => $color_fondo,
  43.    -foreground => $color_texto
  44. )->place( -x => 10, -y => 40 );
  45. my $user = $navedos->Entry(
  46.    -width      => 23,
  47.    -text       => "doddy",
  48.    -background => $color_fondo,
  49.    -foreground => $color_texto
  50. )->place( -x => 60, -y => 43 );
  51.  
  52. $navedos->Label(
  53.    -text       => "Pass : ",
  54.    -font       => "Impact1",
  55.    -background => $color_fondo,
  56.    -foreground => $color_texto
  57. )->place( -x => 10, -y => 70 );
  58. my $pass = $navedos->Entry(
  59.    -width      => 23,
  60.    -text       => "doddy",
  61.    -background => $color_fondo,
  62.    -foreground => $color_texto
  63. )->place( -x => 60, -y => 73 );
  64.  
  65. $navedos->Button(
  66.    -text             => "Connect",
  67.    -width            => 13,
  68.    -command          => \&now,
  69.    -background       => $color_fondo,
  70.    -foreground       => $color_texto,
  71.    -activebackground => $color_texto
  72. )->place( -x => 60, -y => 110 );
  73.  
  74. MainLoop;
  75.  
  76. sub now {
  77.  
  78.    my $host = $host->get;
  79.    my $user = $user->get;
  80.    my $pass = $pass->get;
  81.  
  82.    my $socket = Net::FTP->new($host);
  83.    if ( $socket->login( $user, $pass ) ) {
  84.  
  85.        $navedos->destroy;
  86.  
  87.        my $mandos = MainWindow->new(
  88.            -background => $color_fondo,
  89.            -foreground => $color_texto
  90.        );
  91.        $mandos->title("FTP Manager 0.2 || Coded By Doddy H");
  92.        $mandos->geometry("565x335+20+20");
  93.        $mandos->resizable( 0, 0 );
  94.  
  95.        $menul = $mandos->Frame(
  96.            -relief     => "sunken",
  97.            -bd         => 1,
  98.            -background => $color_fondo,
  99.            -foreground => $color_texto
  100.        );
  101.        my $menulnow = $menul->Menubutton(
  102.            -text             => "Options",
  103.            -underline        => 1,
  104.            -background       => $color_fondo,
  105.            -foreground       => $color_texto,
  106.            -activebackground => $color_texto
  107.        )->pack( -side => "left" );
  108.        my $aboutnow = $menul->Menubutton(
  109.            -text             => "About",
  110.            -underline        => 1,
  111.            -background       => $color_fondo,
  112.            -foreground       => $color_texto,
  113.            -activebackground => $color_texto
  114.        )->pack( -side => "left" );
  115.        my $exitnow = $menul->Menubutton(
  116.            -text             => "Exit",
  117.            -underline        => 1,
  118.            -background       => $color_fondo,
  119.            -foreground       => $color_texto,
  120.            -activebackground => $color_texto
  121.        )->pack( -side => "left" );
  122.        $menul->pack( -side => "top", -fill => "x" );
  123.  
  124.        $menulnow->command(
  125.            -label      => "Delete File",
  126.            -background => $color_fondo,
  127.            -foreground => $color_texto,
  128.            -command    => \&delnow
  129.        );
  130.        $menulnow->command(
  131.            -label      => "Delete Directory",
  132.            -background => $color_fondo,
  133.            -foreground => $color_texto,
  134.            -command    => \&deldirnow
  135.        );
  136.        $menulnow->command(
  137.            -label      => "Make Directory",
  138.            -background => $color_fondo,
  139.            -foreground => $color_texto,
  140.            -command    => \&makedirnow
  141.        );
  142.        $menulnow->command(
  143.            -label      => "Rename",
  144.            -background => $color_fondo,
  145.            -foreground => $color_texto,
  146.            -command    => \&renamenow
  147.        );
  148.        $menulnow->command(
  149.            -label      => "Download",
  150.            -background => $color_fondo,
  151.            -foreground => $color_texto,
  152.            -command    => \&downloadnow
  153.        );
  154.        $menulnow->command(
  155.            -label      => "Upload",
  156.            -background => $color_fondo,
  157.            -foreground => $color_texto,
  158.            -command    => \&updatenow
  159.        );
  160.  
  161.        $aboutnow->command(
  162.            -label      => "About",
  163.            -background => $color_fondo,
  164.            -foreground => $color_texto,
  165.            -command    => \&aboutnownow
  166.        );
  167.        $exitnow->command(
  168.            -label      => "Exit",
  169.            -background => $color_fondo,
  170.            -foreground => $color_texto,
  171.            -command    => \&exitnow
  172.        );
  173.  
  174.        $mandos->Label(
  175.            -text       => "Directory : ",
  176.            -font       => "Impact1",
  177.            -background => $color_fondo,
  178.            -foreground => $color_texto
  179.        )->place( -x => 23, -y => 40 );
  180.        my $actual = $mandos->Entry(
  181.            -text       => "/",
  182.            -width      => 60,
  183.            -background => $color_fondo,
  184.            -foreground => $color_texto
  185.        )->place( -x => 105, -y => 43 );
  186.        $mandos->Button(
  187.            -width            => 8,
  188.            -text             => "Enter",
  189.            -command          => \&dirs,
  190.            -background       => $color_fondo,
  191.            -foreground       => $color_texto,
  192.            -activebackground => $color_texto
  193.        )->place( -x => 480, -y => 43 );
  194.  
  195.        $mandos->Label(
  196.            -text       => "Directory",
  197.            -font       => "Impact1",
  198.            -background => $color_fondo,
  199.            -foreground => $color_texto
  200.        )->place( -x => 130, -y => 90 );
  201.        $mandos->Label(
  202.            -text       => "Files",
  203.            -font       => "Impact1",
  204.            -background => $color_fondo,
  205.            -foreground => $color_texto
  206.        )->place( -x => 350, -y => 90 );
  207.  
  208.        my $dir_now = $mandos->Listbox(
  209.            -width      => 25,
  210.            -height     => 13,
  211.            -background => $color_fondo,
  212.            -foreground => $color_texto
  213.        )->place( -x => 88, -y => 130 );
  214.        my $files_now = $mandos->Listbox(
  215.            -width      => 25,
  216.            -height     => 13,
  217.            -background => $color_fondo,
  218.            -foreground => $color_texto
  219.        )->place( -x => 300, -y => 130 );
  220.  
  221.        sub exitnow {
  222.            $socket->close();
  223.            exit(1);
  224.        }
  225.  
  226.        sub aboutnownow {
  227.            $mandos->Dialog(
  228.                -title            => "About",
  229.                -buttons          => ["OK"],
  230.                -text             => "Coded By Doddy H",
  231.                -background       => $color_fondo,
  232.                -foreground       => $color_texto,
  233.                -activebackground => $color_texto
  234.            )->Show();
  235.        }
  236.  
  237.        sub dirs {
  238.  
  239.            $dir_now->delete( "0.0", "end" );
  240.            $files_now->delete( "0.0", "end" );
  241.  
  242.            if ( my @files = $socket->dir() ) {
  243.  
  244.                my @files_found;
  245.                my @dirs_found;
  246.  
  247.                $socket->cwd( $actual->get );
  248.  
  249.                for my $fil (@files) {
  250.                    my @to = split( " ", $fil );
  251.                    my ( $dir, $file ) = @to[ 0, 8 ];
  252.                    if ( $dir =~ /^d/ ) {
  253.                        $dir_now->insert( "end", $file );
  254.                    }
  255.                    else {
  256.                        $files_now->insert( "end", $file );
  257.                    }
  258.                }
  259.            }
  260.        }
  261.  
  262.        sub delnow {
  263.  
  264.            my $ventdos = MainWindow->new(
  265.                -background => $color_fondo,
  266.                -foreground => $color_texto
  267.            );
  268.            $ventdos->geometry("260x80+20+20");
  269.            $ventdos->title("Delete File");
  270.            $ventdos->resizable( 0, 0 );
  271.  
  272.            $ventdos->Label(
  273.                -text       => "File : ",
  274.                -font       => "Impact",
  275.                -background => $color_fondo,
  276.                -foreground => $color_texto
  277.            )->place( -x => 20, -y => 20 );
  278.            my $filechau = $ventdos->Entry(
  279.                -width      => 20,
  280.                -background => $color_fondo,
  281.                -foreground => $color_texto
  282.            )->place( -x => 60, -y => 26 );
  283.            $ventdos->Button(
  284.                -width            => 6,
  285.                -text             => "Delete",
  286.                -command          => \&delnowdos,
  287.                -background       => $color_fondo,
  288.                -foreground       => $color_texto,
  289.                -activebackground => $color_texto
  290.            )->place( -x => 190, -y => 25 );
  291.  
  292.            sub delnowdos {
  293.                if ( $socket->delete( $filechau->get ) ) {
  294.                    $mandos->Dialog(
  295.                        -title            => "Deleted",
  296.                        -buttons          => ["OK"],
  297.                        -text             => "File Deleted",
  298.                        -background       => $color_fondo,
  299.                        -foreground       => $color_texto,
  300.                        -activebackground => $color_texto
  301.                    )->Show();
  302.                }
  303.                else {
  304.                    $mandos->Dialog(
  305.                        -title            => "Error",
  306.                        -buttons          => ["OK"],
  307.                        -text             => "Error",
  308.                        -background       => $color_fondo,
  309.                        -foreground       => $color_texto,
  310.                        -activebackground => $color_texto
  311.                    )->Show();
  312.                }
  313.            }
  314.        }
  315.  
  316.        sub deldirnow {
  317.  
  318.            my $venttres = MainWindow->new(
  319.                -background => $color_fondo,
  320.                -foreground => $color_texto
  321.            );
  322.            $venttres->geometry("300x80+20+20");
  323.            $venttres->title("Delete Directory");
  324.            $venttres->resizable( 0, 0 );
  325.  
  326.            $venttres->Label(
  327.                -text       => "Directory : ",
  328.                -font       => "Impact",
  329.                -background => $color_fondo,
  330.                -foreground => $color_texto
  331.            )->place( -x => 20, -y => 20 );
  332.            my $dirchau = $venttres->Entry(
  333.                -width      => 20,
  334.                -background => $color_fondo,
  335.                -foreground => $color_texto
  336.            )->place( -x => 99, -y => 26 );
  337.            $venttres->Button(
  338.                -width            => 6,
  339.                -text             => "Delete",
  340.                -command          => \&deldirnowdos,
  341.                -background       => $color_fondo,
  342.                -foreground       => $color_texto,
  343.                -activebackground => $color_texto
  344.            )->place( -x => 230, -y => 25 );
  345.  
  346.            sub deldirnowdos {
  347.                if ( $socket->rmdir( $dirchau->get ) ) {
  348.                    $mandos->Dialog(
  349.                        -title            => "Deleted",
  350.                        -buttons          => ["OK"],
  351.                        -text             => "Directory Deleted",
  352.                        -background       => $color_fondo,
  353.                        -foreground       => $color_texto,
  354.                        -activebackground => $color_texto
  355.                    )->Show();
  356.                }
  357.                else {
  358.                    $mandos->Dialog(
  359.                        -title            => "Error",
  360.                        -buttons          => ["OK"],
  361.                        -text             => "Error",
  362.                        -background       => $color_fondo,
  363.                        -foreground       => $color_texto,
  364.                        -activebackground => $color_texto
  365.                    )->Show();
  366.                }
  367.            }
  368.        }
  369.  
  370.        sub makedirnow {
  371.  
  372.            my $ventcuatro = MainWindow->new(
  373.                -background => $color_fondo,
  374.                -foreground => $color_texto
  375.            );
  376.            $ventcuatro->geometry("300x80+20+20");
  377.            $ventcuatro->title("Make Directory");
  378.            $ventcuatro->resizable( 0, 0 );
  379.  
  380.            $ventcuatro->Label(
  381.                -text       => "Directory : ",
  382.                -font       => "Impact",
  383.                -background => $color_fondo,
  384.                -foreground => $color_texto
  385.            )->place( -x => 20, -y => 20 );
  386.            my $dirnow = $ventcuatro->Entry(
  387.                -width      => 20,
  388.                -background => $color_fondo,
  389.                -foreground => $color_texto
  390.            )->place( -x => 99, -y => 26 );
  391.            $ventcuatro->Button(
  392.                -width            => 6,
  393.                -text             => "Make",
  394.                -command          => \&makedirnowdos,
  395.                -background       => $color_fondo,
  396.                -foreground       => $color_texto,
  397.                -activebackground => $color_texto
  398.            )->place( -x => 230, -y => 25 );
  399.  
  400.            sub makedirnowdos {
  401.  
  402.                if ( $socket->mkdir( $dirnow->get ) ) {
  403.                    $mandos->Dialog(
  404.                        -title            => "Ok",
  405.                        -buttons          => ["OK"],
  406.                        -text             => "Ok",
  407.                        -background       => $color_fondo,
  408.                        -foreground       => $color_texto,
  409.                        -activebackground => $color_texto
  410.                    )->Show();
  411.                }
  412.                else {
  413.                    $mandos->Dialog(
  414.                        -title            => "Error",
  415.                        -buttons          => ["OK"],
  416.                        -text             => "Error",
  417.                        -background       => $color_fondo,
  418.                        -foreground       => $color_texto,
  419.                        -activebackground => $color_texto
  420.                    )->Show();
  421.                }
  422.            }
  423.        }
  424.  
  425.        sub renamenow {
  426.  
  427.            my $ventcinco = MainWindow->new(
  428.                -background => $color_fondo,
  429.                -foreground => $color_texto
  430.            );
  431.            $ventcinco->geometry("440x80+20+20");
  432.            $ventcinco->title("Rename");
  433.            $ventcinco->resizable( 0, 0 );
  434.  
  435.            $ventcinco->Label(
  436.                -text       => "Name : ",
  437.                -font       => "Impact",
  438.                -background => $color_fondo,
  439.                -foreground => $color_texto
  440.            )->place( -x => 20, -y => 20 );
  441.            my $unonow = $ventcinco->Entry(
  442.                -width      => 20,
  443.                -background => $color_fondo,
  444.                -foreground => $color_texto
  445.            )->place( -x => 74, -y => 26 );
  446.  
  447.            $ventcinco->Label(
  448.                -text       => "To : ",
  449.                -font       => "Impact",
  450.                -background => $color_fondo,
  451.                -foreground => $color_texto
  452.            )->place( -x => 210, -y => 20 );
  453.            my $dosnow = $ventcinco->Entry(
  454.                -background => $color_fondo,
  455.                -foreground => $color_texto
  456.            )->place( -x => 240, -y => 26 );
  457.  
  458.            $ventcinco->Button(
  459.                -width            => 6,
  460.                -text             => "Rename",
  461.                -command          => \&renamenowdos,
  462.                -background       => $color_fondo,
  463.                -foreground       => $color_texto,
  464.                -activebackground => $color_texto
  465.            )->place( -x => 372, -y => 26 );
  466.  
  467.            sub renamenowdos {
  468.  
  469.                if ( $socket->rename( $unonow->get, $dosnow->get ) ) {
  470.                    $mandos->Dialog(
  471.                        -title            => "Ok",
  472.                        -buttons          => ["OK"],
  473.                        -text             => "Ok",
  474.                        -background       => $color_fondo,
  475.                        -foreground       => $color_texto,
  476.                        -activebackground => $color_texto
  477.                    )->Show();
  478.                }
  479.                else {
  480.                    $mandos->Dialog(
  481.                        -title            => "Error",
  482.                        -buttons          => ["OK"],
  483.                        -text             => "Error",
  484.                        -background       => $color_fondo,
  485.                        -foreground       => $color_texto,
  486.                        -activebackground => $color_texto
  487.                    )->Show();
  488.                }
  489.            }
  490.        }
  491.  
  492.        sub updatenow {
  493.  
  494.            my $ventseis = MainWindow->new(
  495.                -background => $color_fondo,
  496.                -foreground => $color_texto
  497.            );
  498.            $ventseis->geometry("440x80+20+20");
  499.            $ventseis->title("Upload");
  500.            $ventseis->resizable( 0, 0 );
  501.  
  502.            $ventseis->Label(
  503.                -text       => "File : ",
  504.                -font       => "Impact",
  505.                -background => $color_fondo,
  506.                -foreground => $color_texto
  507.            )->place( -x => 20, -y => 20 );
  508.            my $filenow = $ventseis->Entry(
  509.                -width      => 40,
  510.                -background => $color_fondo,
  511.                -foreground => $color_texto
  512.            )->place( -x => 60, -y => 26 );
  513.  
  514.            $ventseis->Button(
  515.                -width            => 8,
  516.                -text             => "Browse",
  517.                -command          => \&bronow,
  518.                -background       => $color_fondo,
  519.                -foreground       => $color_texto,
  520.                -activebackground => $color_texto
  521.            )->place( -x => 310, -y => 26 );
  522.            $ventseis->Button(
  523.                -width            => 8,
  524.                -text             => "Upload",
  525.                -command          => \&updatenowdos,
  526.                -background       => $color_fondo,
  527.                -foreground       => $color_texto,
  528.                -activebackground => $color_texto
  529.            )->place( -x => 365, -y => 26 );
  530.  
  531.            sub bronow {
  532.                $browse = $ventseis->FileSelect( -directory => getcwd() );
  533.                my $file = $browse->Show;
  534.                $filenow->configure( -text => $file );
  535.            }
  536.  
  537.            sub updatenowdos {
  538.  
  539.                if ( $socket->put( $filenow->get ) ) {
  540.                    $mandos->Dialog(
  541.                        -title            => "File uploaded",
  542.                        -buttons          => ["OK"],
  543.                        -text             => "Ok",
  544.                        -background       => $color_fondo,
  545.                        -foreground       => $color_texto,
  546.                        -activebackground => $color_texto
  547.                    )->Show();
  548.                }
  549.                else {
  550.                    $mandos->Dialog(
  551.                        -title            => "Error",
  552.                        -buttons          => ["OK"],
  553.                        -text             => "Error",
  554.                        -background       => $color_fondo,
  555.                        -foreground       => $color_texto,
  556.                        -activebackground => $color_texto
  557.                    )->Show();
  558.                }
  559.            }
  560.        }
  561.  
  562.        sub downloadnow {
  563.  
  564.            my $ventsiete = MainWindow->new(
  565.                -background => $color_fondo,
  566.                -foreground => $color_texto
  567.            );
  568.            $ventsiete->geometry("270x80+20+20");
  569.            $ventsiete->title("Downloader");
  570.            $ventsiete->resizable( 0, 0 );
  571.  
  572.            $ventsiete->Label(
  573.                -text       => "File : ",
  574.                -font       => "Impact",
  575.                -background => $color_fondo,
  576.                -foreground => $color_texto
  577.            )->place( -x => 20, -y => 20 );
  578.            my $filenownow = $ventsiete->Entry(
  579.                -width      => 20,
  580.                -background => $color_fondo,
  581.                -foreground => $color_texto
  582.            )->place( -x => 59, -y => 26 );
  583.            $ventsiete->Button(
  584.                -width            => 8,
  585.                -text             => "Download",
  586.                -command          => \&downloadnowdos,
  587.                -background       => $color_fondo,
  588.                -foreground       => $color_texto,
  589.                -activebackground => $color_texto
  590.            )->place( -x => 190, -y => 25 );
  591.  
  592.            sub downloadnowdos {
  593.  
  594.                if ( $socket->get( $filenownow->get ) ) {
  595.                    $mandos->Dialog(
  596.                        -title            => "File downloaded",
  597.                        -buttons          => ["OK"],
  598.                        -text             => "Ok",
  599.                        -background       => $color_fondo,
  600.                        -foreground       => $color_texto,
  601.                        -activebackground => $color_texto
  602.                    )->Show();
  603.                }
  604.                else {
  605.                    $mandos->Dialog(
  606.                        -title            => "Error",
  607.                        -buttons          => ["OK"],
  608.                        -text             => "Error",
  609.                        -background       => $color_fondo,
  610.                        -foreground       => $color_texto,
  611.                        -activebackground => $color_texto
  612.                    )->Show();
  613.                }
  614.            }
  615.        }
  616.  
  617.    }
  618.    else {
  619.        $mandos->Dialog(
  620.            -title            => "Error",
  621.            -buttons          => ["OK"],
  622.            -text             => "Error",
  623.            -background       => $color_fondo,
  624.            -foreground       => $color_texto,
  625.            -activebackground => $color_texto
  626.        )->Show();
  627.    }
  628. }
  629.  
  630. #The End ?
  631.  


En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
[Perl] Manager
Scripting
BigBear 0 1,679 Último mensaje 9 Octubre 2011, 17:50 pm
por BigBear
[Perl] FTP Manager
Scripting
BigBear 0 1,700 Último mensaje 14 Octubre 2011, 15:25 pm
por BigBear
[Perl] USB Manager 0.2
Scripting
BigBear 0 1,705 Último mensaje 3 Diciembre 2011, 16:34 pm
por BigBear
[Perl] Manager 0.3
Scripting
BigBear 0 1,634 Último mensaje 19 Enero 2012, 20:35 pm
por BigBear
[Perl] FTP Manager 0.2
Scripting
BigBear 0 1,676 Último mensaje 22 Abril 2012, 05:03 am
por BigBear
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines