[Perl Tk] Scan Port 0.6

Iniciado por BigBear, Mayo 19, 2012, 12:27:28 PM

Tema anterior - Siguiente tema

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

Mayo 19, 2012, 12:27:28 PM Ultima modificación: Marzo 14, 2015, 10:21:21 AM por Expermicid
Nueva version Tk de un scanner de puertos que hice.

Una imagen



El codigo

Código: perl

#!usr/bin/perl
#ScanPort 0.6
#Version Tk
#Coded By Doddy H

use Tk;
use IO::Socket;

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

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

my $kax =
  MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
$kax->geometry("422x130+20+20");
$kax->resizable( 0, 0 );
$kax->title("Scan Port 0.6 || Coded By Doddy H");

$kax->Label(
    -text       => "Host : ",
    -font       => "Impact",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 20, -y => 20 );
my $hostx = $kax->Entry(
    -width      => 30,
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 68, -y => 26 );
$kax->Label(
    -text       => "From port : ",
    -font       => "Impact",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 20, -y => 50 );
my $startx = $kax->Entry(
    -width      => 8,
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 100, -y => 55 );
$kax->Label(
    -text       => "To : ",
    -font       => "Impact",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 170, -y => 50 );
my $endx = $kax->Entry(
    -width      => 8,
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 200, -y => 55 );

$kax->Label(
    -text       => "Progress : ",
    -font       => "Impact",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 20, -y => 84 );
my $tatus = $kax->Entry(
    -width      => 8,
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 100, -y => 90 );
$kax->Button(
    -text             => "Fast",
    -width            => 6,
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -activebackground => $color_texto,
    -command          => \&scanuno
)->place( -x => 158, -y => 88 );
$kax->Button(
    -text             => "Full",
    -width            => 6,
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -activebackground => $color_texto,
    -command          => \&scandos
)->place( -x => 208, -y => 88 );

$kax->Label(
    -text       => "Port Found",
    -font       => "Impact",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 305, -y => 20 );
my $porters = $kax->Listbox(
    -width      => 20,
    -height     => 4,
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 280, -y => 50 );

MainLoop;

sub scanuno {

    my %ports = (
        "21"   => "ftp",
        "22"   => "ssh",
        "25"   => "smtp",
        "80"   => "http",
        "110"  => "pop3",
        "3306" => "mysql"
    );

    $porters->delete( "0.0", "end" );
    $tatus->configure( -text => " " );

    for my $port ( keys %ports ) {
        $kax->update;
        $tatus->configure( -text => $port );
        if (
            new IO::Socket::INET(
                PeerAddr => $hostx->get,
                PeerPort => $port,
                Proto    => "tcp",
                Timeout  => 0.5
            )
          )
        {
            $porters->insert( "end", $port );
        }
    }
    $tatus->configure( -text => " " );
}

sub scandos {

    $porters->delete( "0.0", "end" );
    $tatus->configure( -text => " " );

    for my $port ( $startx->get .. $endx->get ) {
        $kax->update;
        $tatus->configure( -text => $port );
        if (
            new IO::Socket::INET(
                PeerAddr => $hostx->get,
                PeerPort => $port,
                Proto    => "tcp",
                Timeout  => 0.5
            )
          )
        {
            $porters->insert( "end", $port );
        }
    }
    $tatus->configure( -text => " " );
}

# The End ?