Febrero 25, 2018, 01:33:38 pm

Autor Tema: [Perl Tk] Whois Online 0.1  (Leído 669 veces)

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

Desconectado BigBear

  • Yo vivo en CPH
  • ***
  • Mensajes: 736
  • Sexo: Masculino
    • Ver Perfil
[Perl Tk] Whois Online 0.1
« en: Abril 23, 2012, 09:14:17 am »
Version Tk de un cliente whois que funciona mediante una pagina online.

Una imagen


El codigo

Código: You are not allowed to view links. Register or Login
#!usr/bin/perl
#Whois Online 0.1
#Version Tk
#Coded By Doddy H

use Tk;
use Tk::ROText;
use LWP::UserAgent;

my $nave = LWP::UserAgent->new;
$nave->agent(
"Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
);
$nave->timeout(5);

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

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

my $newas =
  MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
$newas->geometry("400x300+50+50");
$newas->title("Whois Online 0.1 || Coded By Doddy H");
$newas->resizable( 0, 0 );

$newas->Label(
    -text       => "Domain : ",
    -font       => "Impact2",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => "10", -y => "10" );
my $dom = $newas->Entry(
    -width      => "30",
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => "85", -y => "13" );

my $console = $newas->Scrolled(
    "ROText",
    -scrollbars => "e",
    -width      => 36,
    -height     => 15,
    -background => $color_fondo,
    -foreground => $color_texto
)->place( -x => 15, -y => 50 );

$newas->Button(
    -text             => "Search",
    -command          => \&buscar,
    -width            => "10",
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -activebackground => $color_texto
)->place( -x => 310, -y => "50" );
$newas->Button(
    -text             => "Clean",
    -command          => \&limpiar,
    -width            => "10",
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -activebackground => $color_texto
)->place( -x => 310, -y => "80" );
$newas->Button(
    -text             => "Exit",
    -command          => \&salir,
    -width            => "10",
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -activebackground => $color_texto
)->place( -x => 310, -y => "110" );

MainLoop;

sub buscar {
    $console->delete( "0.1", "end" );
    my $target = $dom->get;
    $newas->update;
    $console->insert( "end", whois($target) );
    $newas->update;
}

sub limpiar {
    $console->delete( "0.1", "end" );
    $dom->delete( "0.1", "end" );
}

sub salir {
    exit 1;
}

sub whois {

    my $ob   = shift;
    my $code = tomar(
        "http://networking.ringofsaturn.com/Tools/whois.php",
        { "domain" => $ob, "submit" => "submit" }
    );

    my @chau = ( """, ">>>", "<<<" );

    if ( $code =~ /<pre>(.*?)<\/pre>/sig ) {
        my $resul = $1;
        chomp $resul;

        for my $cha (@chau) {
            $resul =~ s/$cha//ig;
        }

        if ( $resul =~ /Whois Server Version/ ) {
            return $resul;
        }
        else {
            return "Not Found";
        }
    }
}

sub tomar {
    my ( $web, $var ) = @_;
    return $nave->post( $web, [ %{$var} ] )->content;
}

# The End ?



exclamation
[Perl] Whois Online 0.1

Iniciado por BigBear

0 Respuestas
693 Vistas
Último mensaje Abril 23, 2012, 09:14:00 am
por BigBear
exclamation
[Perl TK] Client WhoIs

Iniciado por BigBear

0 Respuestas
729 Vistas
Último mensaje Mayo 26, 2011, 07:07:28 pm
por BigBear
exclamation
[Perl Tk] Whois Client 0.2

Iniciado por BigBear

0 Respuestas
635 Vistas
Último mensaje Marzo 31, 2012, 07:23:38 pm
por BigBear
exclamation
[Ruby] Whois Online 0.1

Iniciado por BigBear

0 Respuestas
685 Vistas
Último mensaje Abril 23, 2012, 09:13:02 am
por BigBear
exclamation
[PyQT4] Whois Online 0.2

Iniciado por BigBear

2 Respuestas
1232 Vistas
Último mensaje Agosto 26, 2012, 08:33:44 pm
por JaAViEr
exclamation
[Python] Whois Online 0.1

Iniciado por BigBear

0 Respuestas
1033 Vistas
Último mensaje Abril 23, 2012, 09:13:22 am
por BigBear
exclamation
[Perl Tk] Diccionario Online 0.1

Iniciado por BigBear

0 Respuestas
544 Vistas
Último mensaje Marzo 18, 2012, 07:02:08 pm
por BigBear
xx
Qué es un WHOIS??

Iniciado por Marcelita1000

7 Respuestas
1742 Vistas
Último mensaje Junio 05, 2009, 08:11:55 am
por messerschmitt
xx
whois?????????

Iniciado por cirros

1 Respuestas
1525 Vistas
Último mensaje Enero 02, 2006, 03:21:30 pm
por sdrako
exclamation
[Java] Whois Manager 0.2

Iniciado por BigBear

0 Respuestas
1640 Vistas
Último mensaje Abril 30, 2016, 09:28:21 am
por BigBear