Una imagen
El codigo
Código
#!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 my $dom = $newas->Entry( -width => "30", -background => $color_fondo, -foreground => $color_texto my $console = $newas->Scrolled( "ROText", -scrollbars => "e", -width => 36, -height => 15, -background => $color_fondo, -foreground => $color_texto $newas->Button( -text => "Search", -command => \&buscar, -width => "10", -background => $color_fondo, -foreground => $color_texto, -activebackground => $color_texto $newas->Button( -text => "Clean", -command => \&limpiar, -width => "10", -background => $color_fondo, -foreground => $color_texto, -activebackground => $color_texto $newas->Button( -text => "Exit", -command => \&salir, -width => "10", -background => $color_fondo, -foreground => $color_texto, -activebackground => $color_texto 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 { } sub whois { my $code = tomar( "http://networking.ringofsaturn.com/Tools/whois.php", { "domain" => $ob, "submit" => "submit" } ); my @chau = ( """, ">>>", "<<<" ); if ( $code =~ /<pre>(.*?)<\/pre>/sig ) { my $resul = $1; for my $cha (@chau) { $resul =~ s/$cha//ig; } if ( $resul =~ /Whois Server Version/ ) { } else { } } } sub tomar { my ( $web, $var ) = @_; } # The End ?