[Perl Tk] Ping It 0.1

Iniciado por BigBear, 1 Abril 2012, 03:20 AM

0 Miembros y 1 Visitante están viendo este tema.

BigBear

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


El codigo

Código (perl) [Seleccionar]

#!usr/bin/perl
#Ping It 0.1
#Version Tk
#Coded By Doddy H

use Tk;
use Net::Ping;

my $color_fondo = "black";
my $color_texto = "orange";

#if ( $^O eq 'MSWin32' ) {
#    use Win32::Console;
#    Win32::Console::Free();
#}

my $sax =
 MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
$sax->title("Ping It 0.1 || Coded By Doddy H");
$sax->geometry("350x130+20+20");
$sax->resizable( 0, 0 );

$sax->Label(
   -text       => "Host : ",
   -font       => "Impact",
   -background => $color_fondo,
   -foreground => $color_texto
)->place( -y => 20, -x => 20 );
my $host = $sax->Entry(
   -width      => 30,
   -background => $color_fondo,
   -foreground => $color_texto
)->place( -y => 25, -x => 70 );
$sax->Button(
   -text             => "Ping It",
   -width            => 10,
   -command          => \&pingita,
   -background       => $color_fondo,
   -foreground       => $color_texto,
   -activebackground => $color_texto
)->place( -y => 23, -x => 260 );

my $stat = $sax->Label(
   -text       => "Status : <None>",
   -font       => "Impact",
   -background => $color_fondo,
   -foreground => $color_texto
)->place( -y => 80, -x => 110 );

MainLoop;

sub pingita {

   $clas = Net::Ping->new("icmp");
   if ( $clas->ping( $host->get ) ) {
       $stat->configure( -text => "The host is alive" );
   }
   else {
       $stat->configure( -text => "The host is offline" );
   }
}

#The End ?