Foro - Perl en Español

La comunidad de programadores en Perl de habla hispana.

Obviar


  • Publicidad

FTP Manager 0.2

¿Estás desarrollando un proyecto, o piensas hacerlo? Pon aquí tu propuesta, lo más seguro es que alguien esté interesado en ayudarte.
Publicar una respuesta

FTP Manager 0.2

Notapor BigBear » 2012-04-22 12:38 @568

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:
Imagen

El código del programa:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  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.  
Coloreado en 0.014 segundos, usando GeSHi 1.0.8.4
BigBear
Perlero frecuente
Perlero frecuente
 
Mensajes: 981
Registrado: 2009-03-01 18:39 @818
Arriba

Publicidad

Publicar una respuesta

Volver a Proyectos

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 0 invitados

Powered by phpBB® Forum Software © phpBB Group
Traducción al Español Mexicano por nextgen en colaboración con phpbb-es.com
phpBB SEO
Advertisements by Advertisement Management
cron