[Perl Tk] Ping It 0.1

BigBear · Marzo 31, 2012, 10:31:47 PM

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


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

[Perl Tk] Ping It 0.1

BigBear

Marzo 31, 2012, 10:31:47 PM Ultima modificación: Marzo 14, 2015, 10:18:22 AM por Expermicid