elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Entrar al Canal Oficial Telegram de elhacker.net


+  Foro de elhacker.net
|-+  Programación
| |-+  Scripting
| | |-+  [Perl Tk] Whois Online 0.1
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [Perl Tk] Whois Online 0.1  (Leído 1,517 veces)
BigBear


Desconectado Desconectado

Mensajes: 545



Ver Perfil
[Perl Tk] Whois Online 0.1
« en: 23 Abril 2012, 17:21 pm »

Version Tk de un cliente whois que funciona mediante una pagina online.

Una imagen


El codigo

Código
  1. #!usr/bin/perl
  2. #Whois Online 0.1
  3. #Version Tk
  4. #Coded By Doddy H
  5.  
  6. use Tk;
  7. use Tk::ROText;
  8. use LWP::UserAgent;
  9.  
  10. my $nave = LWP::UserAgent->new;
  11. $nave->agent(
  12. "Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
  13. );
  14. $nave->timeout(5);
  15.  
  16. if ( $^O eq 'MSWin32' ) {
  17.    use Win32::Console;
  18.    Win32::Console::Free();
  19. }
  20.  
  21. my $color_fondo = "black";
  22. my $color_texto = "white";
  23.  
  24. my $newas =
  25.  MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
  26. $newas->geometry("400x300+50+50");
  27. $newas->title("Whois Online 0.1 || Coded By Doddy H");
  28. $newas->resizable( 0, 0 );
  29.  
  30. $newas->Label(
  31.    -text       => "Domain : ",
  32.    -font       => "Impact2",
  33.    -background => $color_fondo,
  34.    -foreground => $color_texto
  35. )->place( -x => "10", -y => "10" );
  36. my $dom = $newas->Entry(
  37.    -width      => "30",
  38.    -background => $color_fondo,
  39.    -foreground => $color_texto
  40. )->place( -x => "85", -y => "13" );
  41.  
  42. my $console = $newas->Scrolled(
  43.    "ROText",
  44.    -scrollbars => "e",
  45.    -width      => 36,
  46.    -height     => 15,
  47.    -background => $color_fondo,
  48.    -foreground => $color_texto
  49. )->place( -x => 15, -y => 50 );
  50.  
  51. $newas->Button(
  52.    -text             => "Search",
  53.    -command          => \&buscar,
  54.    -width            => "10",
  55.    -background       => $color_fondo,
  56.    -foreground       => $color_texto,
  57.    -activebackground => $color_texto
  58. )->place( -x => 310, -y => "50" );
  59. $newas->Button(
  60.    -text             => "Clean",
  61.    -command          => \&limpiar,
  62.    -width            => "10",
  63.    -background       => $color_fondo,
  64.    -foreground       => $color_texto,
  65.    -activebackground => $color_texto
  66. )->place( -x => 310, -y => "80" );
  67. $newas->Button(
  68.    -text             => "Exit",
  69.    -command          => \&salir,
  70.    -width            => "10",
  71.    -background       => $color_fondo,
  72.    -foreground       => $color_texto,
  73.    -activebackground => $color_texto
  74. )->place( -x => 310, -y => "110" );
  75.  
  76. MainLoop;
  77.  
  78. sub buscar {
  79.    $console->delete( "0.1", "end" );
  80.    my $target = $dom->get;
  81.    $newas->update;
  82.    $console->insert( "end", whois($target) );
  83.    $newas->update;
  84. }
  85.  
  86. sub limpiar {
  87.    $console->delete( "0.1", "end" );
  88.    $dom->delete( "0.1", "end" );
  89. }
  90.  
  91. sub salir {
  92.    exit 1;
  93. }
  94.  
  95. sub whois {
  96.  
  97.    my $ob   = shift;
  98.    my $code = tomar(
  99.        "http://networking.ringofsaturn.com/Tools/whois.php",
  100.        { "domain" => $ob, "submit" => "submit" }
  101.    );
  102.  
  103.    my @chau = ( """, ">>>", "<<<" );
  104.  
  105.    if ( $code =~ /<pre>(.*?)<\/pre>/sig ) {
  106.        my $resul = $1;
  107.        chomp $resul;
  108.  
  109.        for my $cha (@chau) {
  110.            $resul =~ s/$cha//ig;
  111.        }
  112.  
  113.        if ( $resul =~ /Whois Server Version/ ) {
  114.            return $resul;
  115.        }
  116.        else {
  117.            return "Not Found";
  118.        }
  119.    }
  120. }
  121.  
  122. sub tomar {
  123.    my ( $web, $var ) = @_;
  124.    return $nave->post( $web, [ %{$var} ] )->content;
  125. }
  126.  
  127. # The End ?
  128.  
  129.  


En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
[Perl Tk] Whois Client 0.2
Scripting
BigBear 0 1,570 Último mensaje 1 Abril 2012, 03:20 am
por BigBear
[Ruby] Whois Online 0.1
Scripting
BigBear 3 3,428 Último mensaje 27 Abril 2012, 16:30 pm
por 0xDani
[Python] Whois Online 0.1
Scripting
BigBear 2 2,196 Último mensaje 23 Abril 2012, 19:44 pm
por BigBear
[Perl] Whois Online 0.1
Scripting
BigBear 0 1,624 Último mensaje 23 Abril 2012, 17:21 pm
por BigBear
[PyQT4] Whois Online 0.2
Scripting
BigBear 0 1,568 Último mensaje 27 Agosto 2012, 00:24 am
por BigBear
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines