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

 

 


Tema destacado: Curso de javascript por TickTack


  Mostrar Mensajes
Páginas: 1 ... 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 [36] 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 ... 55
351  Programación / Scripting / [Perl Tk] Finder Paths 0.7 en: 8 Abril 2012, 01:56 am
Un simple programa para buscar los listados de directorios en una pagina.

Una imagen


El codigo

Código
  1. #!usr/bin/perl
  2. #Finder Paths 0.7
  3. #Version Tk
  4. #Coded By Doddy H
  5.  
  6. use Tk;
  7. use Tk::ListBox;
  8. use LWP::UserAgent;
  9. use URI::Split qw(uri_split);
  10. use HTML::LinkExtor;
  11.  
  12. if ( $^O eq 'MSWin32' ) {
  13.     use Win32::Console;
  14.     Win32::Console::Free();
  15. }
  16.  
  17. my $background_fondo = "black";
  18. my $texto_color      = "cyan";
  19.  
  20. my $nave = LWP::UserAgent->new();
  21. $nave->timeout(5);
  22. $nave->agent(
  23. "Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
  24. );
  25.  
  26. $ha = MainWindow->new(
  27.     -background => $background_fondo,
  28.     -foreground => $texto_color
  29. );
  30. $ha->title("Finder Paths 0.7 || (C) Doddy Hackman 2012");
  31. $ha->geometry("510x430+20+20");
  32. $ha->resizable( 0, 0 );
  33.  
  34. $ha->Label(
  35.     -text       => "Web : ",
  36.     -font       => "Impact1",
  37.     -background => $background_fondo,
  38.     -foreground => $texto_color
  39. )->place( -x => 30, -y => 20 );
  40. my $pagine = $ha->Entry(
  41.     -text       => "http://localhost:8080/paths",
  42.     -width      => 40,
  43.     -background => $background_fondo,
  44.     -foreground => $texto_color
  45. )->place( -x => 80, -y => 23 );
  46. $ha->Button(
  47.     -text             => "Search",
  48.     -width            => 10,
  49.     -command          => \&search,
  50.     -background       => $background_fondo,
  51.     -foreground       => $texto_color,
  52.     -activebackground => $texto_color
  53. )->place( -x => 330, -y => 23 );
  54. $ha->Button(
  55.     -text             => "Logs",
  56.     -width            => 10,
  57.     -command          => \&ver_logs,
  58.     -background       => $background_fondo,
  59.     -foreground       => $texto_color,
  60.     -activebackground => $texto_color
  61. )->place( -x => 405, -y => 23 );
  62.  
  63. $ha->Label(
  64.     -text       => "Type : ",
  65.     -font       => "Impact1",
  66.     -background => $background_fondo,
  67.     -foreground => $texto_color
  68. )->place( -x => 30, -y => 55 );
  69.  
  70. $ha->Radiobutton(
  71.     -text             => "Fast",
  72.     -value            => "fast",
  73.     -variable         => \$type,
  74.     -background       => $background_fondo,
  75.     -foreground       => $texto_color,
  76.     -activebackground => $texto_color
  77. )->place( -x => 80, -y => 57 );
  78. $ha->Radiobutton(
  79.     -text             => "Full",
  80.     -value            => "full",
  81.     -variable         => \$type,
  82.     -background       => $background_fondo,
  83.     -foreground       => $texto_color,
  84.     -activebackground => $texto_color
  85. )->place( -x => 125, -y => 57 );
  86.  
  87. $ha->Label(
  88.     -text       => "Paths Found",
  89.     -font       => "Impact",
  90.     -background => $background_fondo,
  91.     -foreground => $texto_color
  92. )->place( -x => 200, -y => 110 );
  93. my $paths_list = $ha->Listbox(
  94.     -width      => 70,
  95.     -height     => 13,
  96.     -background => $background_fondo,
  97.     -foreground => $texto_color
  98. )->place( -x => 42, -y => 160 );
  99. my $status_now = $ha->Label(
  100.     -text       => "Status : <None>",
  101.     -font       => "Impact",
  102.     -background => $background_fondo,
  103.     -foreground => $texto_color
  104. )->place( -x => 190, -y => 380 );
  105.  
  106. MainLoop;
  107.  
  108. sub search {
  109.  
  110.     $paths_list->delete( "0.0", "end" );
  111.     $status_now->configure( -text => "Status : Scanning" );
  112.     if ( $type eq "fast" ) {
  113.         simple( $pagine->get );
  114.     }
  115.     if ( $type eq "full" ) {
  116.         escalar( $pagine->get );
  117.     }
  118.     $status_now->configure( -text => "Status : <None>" );
  119. }
  120.  
  121. sub ver_logs {
  122.     if ( -f "paths-logs.txt" ) {
  123.         system("paths-logs.txt");
  124.     }
  125.     else {
  126.         $ha->Dialog(
  127.             -title            => "Error",
  128.             -buttons          => ["OK"],
  129.             -text             => "File Not Found",
  130.             -background       => $background_fondo,
  131.             -foreground       => $texto_color,
  132.             -activebackground => $texto_color
  133.         )->Show();
  134.     }
  135. }
  136.  
  137. sub escalar {
  138.  
  139.     my $co    = $_[0];
  140.     my $code  = toma( $_[0] );
  141.     my @links = get_links($code);
  142.  
  143.     if ( $code =~ /Index of (.*)/ig ) {
  144.         $paths_list->insert( "end", $co );
  145.         savefile( "paths-logs.txt", $co );
  146.         my $dir_found = $1;
  147.         chomp $dir_found;
  148.         while ( $code =~ /<a href=\"(.*)\">(.*)<\/a>/ig ) {
  149.             my $ruta   = $1;
  150.             my $nombre = $2;
  151.             unless ( $nombre =~ /Parent Directory/ig
  152.                 or $nombre =~ /Description/ig )
  153.             {
  154.                 push( @encontrados, $_[0] . "/" . $nombre );
  155.             }
  156.         }
  157.     }
  158.  
  159.     for my $com (@links) {
  160.         $ha->update;
  161.         my ( $scheme, $auth, $path, $query, $frag ) = uri_split( $_[0] );
  162.         if ( $path =~ /\/(.*)$/ ) {
  163.             my $path1 = $1;
  164.             $_[0] =~ s/$path1//ig;
  165.             my ( $scheme, $auth, $path, $query, $frag ) = uri_split($com);
  166.             if ( $path =~ /(.*)\// ) {
  167.                 my $parche = $1;
  168.                 unless ( $repetidos =~ /$parche/ ) {
  169.                     $repetidos .= " " . $parche;
  170.                     my $yeah = "http://" . $auth . $parche;
  171.                     escalar($yeah);
  172.                 }
  173.             }
  174.             for (@encontrados) {
  175.                 $ha->update;
  176.                 escalar($_);
  177.             }
  178.         }
  179.     }
  180. }
  181.  
  182. sub simple {
  183.  
  184.     my $code  = toma( $_[0] );
  185.     my @links = get_links($code);
  186.  
  187.     for my $com (@links) {
  188.         $ha->update;
  189.         my ( $scheme, $auth, $path, $query, $frag ) = uri_split( $_[0] );
  190.         if ( $path =~ /\/(.*)$/ ) {
  191.             my $path1 = $1;
  192.             $_[0] =~ s/$path1//ig;
  193.             my ( $scheme, $auth, $path, $query, $frag ) = uri_split($com);
  194.             if ( $path =~ /(.*)\// ) {
  195.                 my $parche = $1;
  196.                 unless ( $repetidos =~ /$parche/ ) {
  197.                     $repetidos .= " " . $parche;
  198.                     my $code = toma( "http://" . $auth . $parche );
  199.  
  200.                     if ( $code =~ /Index of (.*)</ig ) {
  201.                         my $dir_found = $1;
  202.                         chomp $dir_found;
  203.                         my $yeah = "http://" . $auth . $parche;
  204.                         $paths_list->insert( "end", $yeah );
  205.                         savefile( "paths-logs.txt", $yeah );
  206.                     }
  207.                 }
  208.             }
  209.         }
  210.     }
  211. }
  212.  
  213. sub toma {
  214.     return $nave->get( $_[0] )->content;
  215. }
  216.  
  217. sub get_links {
  218.  
  219.     $test = HTML::LinkExtor->new( \&agarrar )->parse( $_[0] );
  220.     return @links;
  221.  
  222.     sub agarrar {
  223.         my ( $a, %b ) = @_;
  224.         push( @links, values %b );
  225.     }
  226. }
  227.  
  228. sub savefile {
  229.     open( SAVE, ">>" . $_[0] );
  230.     print SAVE $_[1] . "\n";
  231.     close SAVE;
  232. }
  233.  
  234. #The End ?
  235.  
352  Programación / Scripting / [Perl] Finder Paths 0.6 en: 8 Abril 2012, 01:55 am
Un simple script para buscar los famosos listados de directorios en una pagina.

Código
  1. #!usr/bin/perl
  2. #Finder Paths 0.6
  3. #Coded By Doddy H
  4.  
  5. use LWP::UserAgent;
  6. use URI::Split qw(uri_split);
  7. use HTML::LinkExtor;
  8.  
  9. my $nave = LWP::UserAgent->new();
  10. $nave->timeout(5);
  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.  
  15. head();
  16.  
  17. print "[+] Web : ";
  18. chomp( my $web = <stdin> );
  19.  
  20. print "\n\n[+] Scan Type\n\n";
  21. print "[+] 1 : Fast\n";
  22. print "[+] 2 : Full\n";
  23.  
  24. print "\n\n[+] Option : ";
  25. chomp( my $op = <stdin> );
  26.  
  27. print "\n\n[+] Scanning ....\n\n\n";
  28.  
  29. if ( $op eq "1" ) {
  30.     simple($web);
  31. }
  32. elsif ( $op eq "2" ) {
  33.     escalar($web);
  34. }
  35. else {
  36.     simple($web);
  37. }
  38. copyright();
  39.  
  40. sub escalar {
  41.  
  42.     my $co    = $_[0];
  43.     my $code  = toma( $_[0] );
  44.     my @links = get_links($code);
  45.  
  46.     if ( $code =~ /Index of (.*)/ig ) {
  47.         print "[+] Link : $co\n";
  48.         savefile( "paths-logs.txt", $co );
  49.         my $dir_found = $1;
  50.         chomp $dir_found;
  51.         while ( $code =~ /<a href=\"(.*)\">(.*)<\/a>/ig ) {
  52.             my $ruta   = $1;
  53.             my $nombre = $2;
  54.             unless ( $nombre =~ /Parent Directory/ig
  55.                 or $nombre =~ /Description/ig )
  56.             {
  57.                 push( @encontrados, $_[0] . "/" . $nombre );
  58.             }
  59.         }
  60.     }
  61.  
  62.     for my $com (@links) {
  63.         my ( $scheme, $auth, $path, $query, $frag ) = uri_split( $_[0] );
  64.         if ( $path =~ /\/(.*)$/ ) {
  65.             my $path1 = $1;
  66.             $_[0] =~ s/$path1//ig;
  67.             my ( $scheme, $auth, $path, $query, $frag ) = uri_split($com);
  68.             if ( $path =~ /(.*)\// ) {
  69.                 my $parche = $1;
  70.                 unless ( $repetidos =~ /$parche/ ) {
  71.                     $repetidos .= " " . $parche;
  72.                     my $yeah = "http://" . $auth . $parche;
  73.                     escalar($yeah);
  74.                 }
  75.             }
  76.             for (@encontrados) {
  77.                 escalar($_);
  78.             }
  79.         }
  80.     }
  81. }
  82.  
  83. sub simple {
  84.  
  85.     my $code  = toma( $_[0] );
  86.     my @links = get_links($code);
  87.  
  88.     for my $com (@links) {
  89.         my ( $scheme, $auth, $path, $query, $frag ) = uri_split( $_[0] );
  90.         if ( $path =~ /\/(.*)$/ ) {
  91.             my $path1 = $1;
  92.             $_[0] =~ s/$path1//ig;
  93.             my ( $scheme, $auth, $path, $query, $frag ) = uri_split($com);
  94.             if ( $path =~ /(.*)\// ) {
  95.                 my $parche = $1;
  96.                 unless ( $repetidos =~ /$parche/ ) {
  97.                     $repetidos .= " " . $parche;
  98.                     my $code = toma( "http://" . $auth . $parche );
  99.  
  100.                     if ( $code =~ /Index of (.*)</ig ) {
  101.                         my $dir_found = $1;
  102.                         chomp $dir_found;
  103.                         my $yeah = "http://" . $auth . $parche;
  104.                         print "[+] Link : $yeah\n";
  105.                         savefile( "paths-logs.txt", $yeah );
  106.                     }
  107.                 }
  108.             }
  109.         }
  110.     }
  111. }
  112.  
  113. sub toma {
  114.     return $nave->get( $_[0] )->content;
  115. }
  116.  
  117. sub get_links {
  118.  
  119.     $test = HTML::LinkExtor->new( \&agarrar )->parse( $_[0] );
  120.     return @links;
  121.  
  122.     sub agarrar {
  123.         my ( $a, %b ) = @_;
  124.         push( @links, values %b );
  125.     }
  126. }
  127.  
  128. sub savefile {
  129.     open( SAVE, ">>" . $_[0] );
  130.     print SAVE $_[1] . "\n";
  131.     close SAVE;
  132. }
  133.  
  134. sub head {
  135.     print qq(
  136.  
  137.  
  138.  @@@@@ @           @             @@@@@           @         
  139.  @                 @             @    @       @  @         
  140.  @                 @             @    @       @  @         
  141.  @     @ @ @@   @@@@  @@@  @@    @    @  @@@  @@ @ @@   @@ 
  142.  @@@@  @ @@  @ @   @ @   @ @     @@@@@      @ @  @@  @ @  @
  143.  @     @ @   @ @   @ @@@@@ @     @       @@@@ @  @   @  @  
  144.  @     @ @   @ @   @ @     @     @      @   @ @  @   @   @ 
  145.  @     @ @   @ @   @ @   @ @     @      @   @ @  @   @ @  @
  146.  @     @ @   @  @@@@  @@@  @     @       @@@@  @ @   @  @@ 
  147.  
  148.  
  149.  
  150.  
  151.  
  152. );
  153. }
  154.  
  155. sub copyright {
  156.     print "\n\n(C) Doddy Hackman 2012\n\n";
  157.     <stdin>;
  158.     exit(1);
  159. }
  160.  
  161. # The End ?
  162.  
353  Programación / Scripting / Re: [Ruby] Buscador de sueños 0.1 en: 4 Abril 2012, 19:15 pm
parece que el problema solo esta en la version de ruby porque tu extraño sueño de "drogar y violar aliens xD" es encontrado como droga en las demas traducciones.
parece que en la version de ruby solo se permite usar una palabra ej vibora porque sino da un error en el parseo del link , vere como se puede arreglar.

pd:  hipotesis uno , cambiar la funcion toma()
pd2 : que sera mas raro el script en si o soñar con "drogar y violar aliens" xDDD.
 
354  Programación / Scripting / [Perl] Buscador de sueños 0.1 en: 4 Abril 2012, 18:25 pm
Un simple buscador de sueños en Perl.

Código
  1. #!usr/bin/perl
  2. #Buscador de sueños 0.1
  3. #Coded By Doddy H
  4.  
  5. use LWP::UserAgent;
  6.  
  7. my $nave = LWP::UserAgent->new;
  8. $nave->agent(
  9. "Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
  10. );
  11. $nave->timeout(5);
  12.  
  13. header();
  14.  
  15. print "\n[+] Palabra : ";
  16. chomp( my $string = <stdin> );
  17.  
  18. my $code =
  19.   toma( "http://www.mis-suenos.org/interpretaciones/buscar?text=" . $string );
  20.  
  21. if ( $code =~ /<li>(.*)<\/li>/ ) {
  22.     my $si = $1;
  23.     if ( $si eq " " ) {
  24.         print "\n\n[-] No se encontro\n";
  25.     }
  26.     else {
  27.         print "\n\n[+] Significado : $si\n";
  28.     }
  29. }
  30.  
  31. copyright();
  32.  
  33. sub header {
  34.     print "\n\n-- == Buscador de sueños == --\n\n";
  35. }
  36.  
  37. sub copyright {
  38.     print "\n\n(C) Doddy Hackman 2012\n\n";
  39.     <stdin>;
  40.     exit(1);
  41. }
  42.  
  43. sub toma {
  44.     return $nave->get( $_[0] )->content;
  45. }
  46.  
  47. #The End ?
  48.  
355  Programación / Scripting / [Python] Buscador de sueños 0.1 en: 4 Abril 2012, 18:24 pm
Un simple buscador de sueños hecho en Python.

Código
  1. #!usr/bin/python
  2. #coding: utf-8
  3. #Buscador de sueños 0.1
  4. #Coded By Doddy H
  5.  
  6. import urllib2,re,sys
  7.  
  8. def toma(web) :
  9.  nave = urllib2.Request(web)
  10.  nave.add_header('User-Agent','Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.9.0.5) Gecko/2008120122 Firefox/3.0.5');
  11.  op = urllib2.build_opener()
  12.  return op.open(nave).read()
  13.  
  14. def head():
  15.   print "\n-- == Buscador de sueños == --\n"
  16.  
  17. def copyright():
  18.  print "\n\n(C) Doddy Hackman 2012\n"
  19.  raw_input()
  20.  sys.exit(1)
  21.  
  22. head()
  23.  
  24. url = raw_input("\n\n[+] Texto : ")
  25.  
  26. try:
  27.  code = toma("http://www.mis-suenos.org/interpretaciones/buscar?text="+url)
  28.  if (re.findall("<li>(.*)<\/li>",code)):
  29.    re = re.findall("<li>(.*)<\/li>",code)
  30.    re = re[0]
  31.    if not re=="":
  32.      print "\n\n[+] Significado : "+re
  33.    else:
  34.      print "[-] No se encontro significado\n"
  35. except:
  36.  print "[-] Error\n"
  37.  
  38. copyright()
  39.  
  40. # The End
  41.  
356  Programación / Scripting / [Ruby] Buscador de sueños 0.1 en: 4 Abril 2012, 18:24 pm
Un buscador de sueños en Ruby

Código
  1. #!usr/bin/ruby
  2. #Buscador de sueños 0.1
  3. #Coded By Doddy H
  4.  
  5. require "net/http"
  6.  
  7. def head()
  8.   print "\n\n-- == Buscador de sueños == --\n\n"
  9. end
  10.  
  11. def copyright()
  12.   print "\n\n(C) Doddy Hackman 2012\n\n"
  13.   gets.chomp
  14.   exit(1)
  15. end
  16.  
  17. def toma(web)
  18.   return Net::HTTP.get_response(URI.parse(web)).body
  19. end
  20.  
  21. head()
  22.  
  23. print "\n[+] Texto : "
  24. string = gets.chomp
  25.  
  26. url = "http://www.mis-suenos.org/interpretaciones/buscar?text="+string
  27.  
  28. code = toma(url)
  29.  
  30. if code=~/<li>(.*)<\/li>/
  31.   text = $1
  32.   if text == " "
  33.     print "\n\n[-] No encontrado"
  34.   else
  35.     print "\n\n[+] Significado : "+text
  36.   end
  37. end
  38.  
  39. copyright()
  40.  
  41. #The End ? 
  42.  
357  Programación / Scripting / [Perl Tk] Ping It 0.1 en: 1 Abril 2012, 03:20 am
Siempre habia querido hacer este programa en Perl , pero en ese entonces no tenia el tiempo al pedo necesario para hacerlo , que mejor que un sabado a la noche para hacerlo , claro que los sabados y domingo me los tomo como descanso ya que los dias de la semana estudio para unos examenes que se me vienen dentro de poco.

Una imagen del programa


El codigo

Código
  1. #!usr/bin/perl
  2. #Ping It 0.1
  3. #Version Tk
  4. #Coded By Doddy H
  5.  
  6. use Tk;
  7. use Net::Ping;
  8.  
  9. my $color_fondo = "black";
  10. my $color_texto = "orange";
  11.  
  12. #if ( $^O eq 'MSWin32' ) {
  13. #    use Win32::Console;
  14. #    Win32::Console::Free();
  15. #}
  16.  
  17. my $sax =
  18.   MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
  19. $sax->title("Ping It 0.1 || Coded By Doddy H");
  20. $sax->geometry("350x130+20+20");
  21. $sax->resizable( 0, 0 );
  22.  
  23. $sax->Label(
  24.     -text       => "Host : ",
  25.     -font       => "Impact",
  26.     -background => $color_fondo,
  27.     -foreground => $color_texto
  28. )->place( -y => 20, -x => 20 );
  29. my $host = $sax->Entry(
  30.     -width      => 30,
  31.     -background => $color_fondo,
  32.     -foreground => $color_texto
  33. )->place( -y => 25, -x => 70 );
  34. $sax->Button(
  35.     -text             => "Ping It",
  36.     -width            => 10,
  37.     -command          => \&pingita,
  38.     -background       => $color_fondo,
  39.     -foreground       => $color_texto,
  40.     -activebackground => $color_texto
  41. )->place( -y => 23, -x => 260 );
  42.  
  43. my $stat = $sax->Label(
  44.     -text       => "Status : <None>",
  45.     -font       => "Impact",
  46.     -background => $color_fondo,
  47.     -foreground => $color_texto
  48. )->place( -y => 80, -x => 110 );
  49.  
  50. MainLoop;
  51.  
  52. sub pingita {
  53.  
  54.     $clas = Net::Ping->new("icmp");
  55.     if ( $clas->ping( $host->get ) ) {
  56.         $stat->configure( -text => "The host is alive" );
  57.     }
  58.     else {
  59.         $stat->configure( -text => "The host is offline" );
  60.     }
  61. }
  62.  
  63. #The End ?
  64.  
358  Programación / Scripting / [Perl Tk] Whois Client 0.2 en: 1 Abril 2012, 03:20 am
La version mejorada de un cliente whois que hice hace un largooooooooo tiempo.

Para usarlo tienen que instalar el modulo necesario de la siguiente manera.

Código:
ppm install http://www.bribes.org/perl/ppm/Net-Whois-Raw.ppd

Una imagen del programa


El codigo es

Código
  1. #!usr/bin/perl
  2. #Whois Client 0.2
  3. #Coded By Doddy H
  4. #ppm install http://www.bribes.org/perl/ppm/Net-Whois-Raw.ppd
  5.  
  6. use Tk;
  7. use Tk::ROText;
  8. use Net::Whois::Raw;
  9.  
  10. #if ( $^O eq 'MSWin32' ) {
  11. #    use Win32::Console;
  12. #   Win32::Console::Free();
  13. #}
  14.  
  15. my $color_fondo = "black";
  16. my $color_texto = "cyan";
  17.  
  18. $yu =
  19.   MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
  20. $yu->title("Whois Client 0.2 || Coded By Doddy H");
  21. $yu->geometry("400x350+20+20");
  22. $yu->resizable( 0, 0 );
  23.  
  24. $yu->Label(
  25.     -text       => "Page : ",
  26.     -font       => "Impact",
  27.     -background => $color_fondo,
  28.     -foreground => $color_texto
  29. )->place( -x => 20, -y => 20 );
  30. my $targe = $yu->Entry(
  31.     -width      => 35,
  32.     -background => $color_fondo,
  33.     -foreground => $color_texto
  34. )->place( -x => 70, -y => 26 );
  35. $yu->Button(
  36.     -text             => "Get Info",
  37.     -width            => 10,
  38.     -background       => $color_fondo,
  39.     -foreground       => $color_texto,
  40.     -activebackground => $color_texto,
  41.     -command          => \&whoisit
  42. )->place( -x => 290, -y => 24 );
  43. $yu->Label(
  44.     -text       => "Information",
  45.     -font       => "Impact",
  46.     -background => $color_fondo,
  47.     -foreground => $color_texto
  48. )->place( -x => 140, -y => 85 );
  49. my $data = $yu->Scrolled(
  50.     "ROText",
  51.     -width      => 40,
  52.     -height     => 12,
  53.     -scrollbars => "e",
  54.     -background => $color_fondo,
  55.     -foreground => $color_texto
  56. )->place( -x => 45, -y => 150 );
  57.  
  58. sub whoisit {
  59.  
  60.     $data->delete( "0.1", "end" );
  61.     $data->insert( "end", whois( $targe->get ) );
  62.  
  63. }
  64.  
  65. MainLoop;
  66.  
  67. #The End ?
  68.  
359  Programación / Scripting / [Perl Tk] Get IP 0.1 en: 1 Abril 2012, 02:04 am
Estaba muriendome de aburrimiento y me programe este pequeño programa en 5 minutos , que sirve para obtener la IP de un Host cualquiera.

Una imagen


El codigo

Código
  1. #!usr/bin/perl
  2. #Get IP 0.1
  3. #Version Tk
  4. #Coded By Doddy H
  5.  
  6. use Tk;
  7. use IO::Socket;
  8.  
  9. my $color_fondo = "black";
  10. my $color_texto = "yellow";
  11.  
  12. #if ( $^O eq 'MSWin32' ) {
  13. #    use Win32::Console;
  14. #   Win32::Console::Free();
  15. #}
  16.  
  17. my $ua =
  18.   MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
  19. $ua->title("Get IP || Coded By Doddy H");
  20. $ua->geometry("350x110+20+20");
  21. $ua->resizable( 0, 0 );
  22.  
  23. $ua->Label(
  24.     -text       => "Host : ",
  25.     -font       => "Impact",
  26.     -background => $color_fondo,
  27.     -foreground => $color_texto
  28. )->place( -y => 20, -x => 20 );
  29. my $host = $ua->Entry(
  30.     -width      => 30,
  31.     -background => $color_fondo,
  32.     -foreground => $color_texto
  33. )->place( -y => 25, -x => 70 );
  34. $ua->Button(
  35.     -text             => "Get IP",
  36.     -width            => 10,
  37.     -command          => \&quien,
  38.     -background       => $color_fondo,
  39.     -foreground       => $color_texto,
  40.     -activebackground => $color_texto
  41. )->place( -y => 23, -x => 260 );
  42.  
  43. $ua->Label(
  44.     -text       => "IP : ",
  45.     -font       => "Impact",
  46.     -background => $color_fondo,
  47.     -foreground => $color_texto
  48. )->place( -y => 60, -x => 20 );
  49. my $ip = $ua->Entry(
  50.     -width      => 33,
  51.     -background => $color_fondo,
  52.     -foreground => $color_texto
  53. )->place( -y => 65, -x => 52 );
  54.  
  55. MainLoop;
  56.  
  57. sub quien {
  58.     $ip->configure( -text => get_ip( $host->get ) );
  59. }
  60.  
  61. sub get_ip {
  62.     my $get = gethostbyname( $_[0] );
  63.     return inet_ntoa($get);
  64. }
  65.  
  66. #The End ?
  67.  
360  Programación / Scripting / Re: [Perl Tk] LocateIP 0.4 en: 1 Abril 2012, 01:02 am
Es porque te hace falta instalar Tk.

Si estas usando ubuntu podes instalarlo con Synaptic.
Páginas: 1 ... 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 [36] 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 ... 55
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines