Version Tk de un cliente whois que funciona mediante una pagina online.
Una imagen
(http://doddyhackman.webcindario.com/images/whoisonline.jpg)
El codigo
#!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 {
}
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 ) = @_;
return $nave->post( $web, [ %{$var} ] )->content; }
# The End ?