Foro de elhacker.net

Programación => Scripting => Mensaje iniciado por: BigBear en 1 Abril 2012, 03:20 am



Título: [Perl Tk] Ping It 0.1
Publicado por: BigBear en 1 Abril 2012, 03:20 am
Siempre habia querido hacer este programa en Perl , pero en ese entonces no tenia el tiempo al pedo necesario para hacerlo , que mejor que un sabado a la noche para hacerlo , claro que los sabados y domingo me los tomo como descanso ya que los dias de la semana estudio para unos examenes que se me vienen dentro de poco.

Una imagen del programa

(http://doddyhackman.webcindario.com/images/pingit.jpg)

El codigo

Código
  1. #!usr/bin/perl
  2. #Ping It 0.1
  3. #Version Tk
  4. #Coded By Doddy H
  5.  
  6. use Tk;
  7. use Net::Ping;
  8.  
  9. my $color_fondo = "black";
  10. my $color_texto = "orange";
  11.  
  12. #if ( $^O eq 'MSWin32' ) {
  13. #    use Win32::Console;
  14. #    Win32::Console::Free();
  15. #}
  16.  
  17. my $sax =
  18.  MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
  19. $sax->title("Ping It 0.1 || Coded By Doddy H");
  20. $sax->geometry("350x130+20+20");
  21. $sax->resizable( 0, 0 );
  22.  
  23. $sax->Label(
  24.    -text       => "Host : ",
  25.    -font       => "Impact",
  26.    -background => $color_fondo,
  27.    -foreground => $color_texto
  28. )->place( -y => 20, -x => 20 );
  29. my $host = $sax->Entry(
  30.    -width      => 30,
  31.    -background => $color_fondo,
  32.    -foreground => $color_texto
  33. )->place( -y => 25, -x => 70 );
  34. $sax->Button(
  35.    -text             => "Ping It",
  36.    -width            => 10,
  37.    -command          => \&pingita,
  38.    -background       => $color_fondo,
  39.    -foreground       => $color_texto,
  40.    -activebackground => $color_texto
  41. )->place( -y => 23, -x => 260 );
  42.  
  43. my $stat = $sax->Label(
  44.    -text       => "Status : <None>",
  45.    -font       => "Impact",
  46.    -background => $color_fondo,
  47.    -foreground => $color_texto
  48. )->place( -y => 80, -x => 110 );
  49.  
  50. MainLoop;
  51.  
  52. sub pingita {
  53.  
  54.    $clas = Net::Ping->new("icmp");
  55.    if ( $clas->ping( $host->get ) ) {
  56.        $stat->configure( -text => "The host is alive" );
  57.    }
  58.    else {
  59.        $stat->configure( -text => "The host is offline" );
  60.    }
  61. }
  62.  
  63. #The End ?
  64.