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


  Mostrar Temas
Páginas: 1 ... 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 [28] 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43
271  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.  
272  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.  
273  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.  
274  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.  
275  Programación / Scripting / [Perl Tk] Finder Pass 0.4 en: 31 Marzo 2012, 22:47 pm
La version Tk de este programa que eh hecho para crackear hashes md5 de forma online

Una imagen seria


El codigo

Código
  1. #!usr/bin/perl
  2. #Finder Pass 0.4
  3. #Version Tk
  4. #Coded By Doddy H
  5.  
  6. use Tk;
  7. use Tk::ListBox;
  8. use Tk::Dialog;
  9. use Tk::FileSelect;
  10. use Cwd;
  11. use LWP::UserAgent;
  12.  
  13. my $nave = LWP::UserAgent->new;
  14. $nave->agent(
  15. "Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
  16. );
  17. $nave->timeout(5);
  18.  
  19. if ( $^O eq 'MSWin32' ) {
  20.     use Win32::Console;
  21.     Win32::Console::Free();
  22. }
  23.  
  24. my $color_fondo = "black";
  25. my $color_texto = "red";
  26.  
  27. my $ta =
  28.   MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
  29. $ta->title("Finder Pass 0.4 (C) Doddy Hackman 2012");
  30. $ta->geometry("600x400+20+20");
  31. $ta->resizable( 0, 0 );
  32.  
  33. $d = $ta->Frame(
  34.     -relief     => "sunken",
  35.     -bd         => 1,
  36.     -background => $color_fondo,
  37.     -foreground => $color_texto
  38. );
  39. my $max = $d->Menubutton(
  40.     -text             => "Options",
  41.     -underline        => 1,
  42.     -background       => $color_fondo,
  43.     -foreground       => $color_texto,
  44.     -activebackground => $color_texto
  45. )->pack( -side => "left" );
  46. my $aba = $d->Menubutton(
  47.     -text             => "About",
  48.     -underline        => 1,
  49.     -background       => $color_fondo,
  50.     -foreground       => $color_texto,
  51.     -activebackground => $color_texto
  52. )->pack( -side => "left" );
  53. my $exa = $d->Menubutton(
  54.     -text             => "Exit",
  55.     -underline        => 1,
  56.     -background       => $color_fondo,
  57.     -foreground       => $color_texto,
  58.     -activebackground => $color_texto
  59. )->pack( -side => "left" );
  60. $d->pack( -side => "top", -fill => "x" );
  61.  
  62. $max->command(
  63.     -label      => "Crack",
  64.     -background => $color_fondo,
  65.     -foreground => $color_texto,
  66.     -command    => \&cracknow
  67. );
  68. $max->command(
  69.     -label      => "Add Hash",
  70.     -background => $color_fondo,
  71.     -foreground => $color_texto,
  72.     -command    => \&addhash
  73. );
  74. $max->command(
  75.     -label      => "Add File with hashes",
  76.     -background => $color_fondo,
  77.     -foreground => $color_texto,
  78.     -command    => \&addfilea
  79. );
  80. $max->command(
  81.     -label      => "Clean List",
  82.     -background => $color_fondo,
  83.     -foreground => $color_texto,
  84.     -command    => \&cleanow
  85. );
  86.  
  87. $aba->command(
  88.     -label      => "About",
  89.     -background => $color_fondo,
  90.     -foreground => $color_texto,
  91.     -command    => \&about
  92. );
  93.  
  94. $exa->command(
  95.     -label      => "Exit",
  96.     -background => $color_fondo,
  97.     -foreground => $color_texto,
  98.     -command    => \&salir
  99. );
  100.  
  101. $ta->Label(
  102.     -text       => "Hashes",
  103.     -background => $color_fondo,
  104.     -foreground => $color_texto,
  105.     -font       => "Impact"
  106. )->place( -x => 110, -y => 50 );
  107. my $had = my $has = $ta->Listbox(
  108.     -width      => 36,
  109.     -height     => 15,
  110.     -background => $color_fondo,
  111.     -foreground => $color_texto
  112. )->place( -x => 32, -y => 100 );
  113.  
  114. $ta->Label(
  115.     -text       => "Results",
  116.     -background => $color_fondo,
  117.     -foreground => $color_texto,
  118.     -font       => "Impact"
  119. )->place( -x => 380, -y => 50 );
  120. my $red = my $res = $ta->Listbox(
  121.     -width      => 36,
  122.     -height     => 15,
  123.     -background => $color_fondo,
  124.     -foreground => $color_texto
  125. )->place( -x => 300, -y => 100 );
  126.  
  127. my $status = $ta->Label(
  128.     -text       => "Status : <None>",
  129.     -background => $color_fondo,
  130.     -foreground => $color_texto,
  131.     -font       => "Impact1"
  132. )->place( -x => 220, -y => 350 );
  133.  
  134. MainLoop;
  135.  
  136. sub cracknow {
  137.  
  138.     my @hashes = $had->get( "0.0", "end" );
  139.     my @hashes = repes(@hashes);
  140.  
  141.     for my $ha (@hashes) {
  142.         $status->configure( -text => "[+] Searching .." );
  143.         $ta->update;
  144.         my $re = crackit($ha);
  145.         if ( $re =~ /false01/ig ) {
  146.             $red->insert( "end", "Not Found" );
  147.         }
  148.         else {
  149.             $red->insert( "end", $re );
  150.             savefile( "hashes-found.txt", $ha . ":" . $re );
  151.         }
  152.     }
  153.     $status->configure( -text => "Status : <None>" );
  154. }
  155.  
  156. sub addfilea {
  157.  
  158.     my $mediox = MainWindow->new(
  159.         -background => $color_fondo,
  160.         -foreground => $color_texto
  161.     );
  162.     $mediox->geometry("390x90+20+20");
  163.     $mediox->resizable( 0, 0 );
  164.     $mediox->title("Add File");
  165.  
  166.     $mediox->Label(
  167.         -text       => "File : ",
  168.         -background => $color_fondo,
  169.         -foreground => $color_texto,
  170.         -font       => "Impact1"
  171.     )->place( -x => 10, -y => 30 );
  172.     my $enafa = $mediox->Entry(
  173.         -background => $color_fondo,
  174.         -foreground => $color_texto,
  175.         -width      => 33
  176.     )->place( -y => 33, -x => 55 );
  177.     $mediox->Button(
  178.         -text             => "Browse",
  179.         -background       => $color_fondo,
  180.         -foreground       => $color_texto,
  181.         -width            => 7,
  182.         -activebackground => $color_texto,
  183.         -command          => \&bronax
  184.     )->place( -y => 33, -x => 265 );
  185.     $mediox->Button(
  186.         -text             => "Load",
  187.         -background       => $color_fondo,
  188.         -foreground       => $color_texto,
  189.         -width            => 7,
  190.         -activebackground => $color_texto,
  191.         -command          => \&bronaxx
  192.     )->place( -y => 33, -x => 320 );
  193.  
  194.     sub bronax {
  195.         $browse = $mediox->FileSelect( -directory => getcwd() );
  196.         my $fileax = $browse->Show;
  197.         $enafa->configure( -text => $fileax );
  198.     }
  199.  
  200.     sub bronaxx {
  201.         open( OPEN, $enafa->get );
  202.         my @ve = <OPEN>;
  203.         close OPEN;
  204.         for my $no (@ve) {
  205.             chomp $no;
  206.             if ( ver_length($no) ) {
  207.                 $had->insert( "end", $no );
  208.             }
  209.         }
  210.     }
  211. }
  212.  
  213. sub addhash {
  214.  
  215.     my $plac = MainWindow->new(
  216.         -background => $color_fondo,
  217.         -foreground => $color_texto
  218.     );
  219.     $plac->geometry("350x90+20+20");
  220.     $plac->resizable( 0, 0 );
  221.     $plac->title("Add Hash");
  222.  
  223.     $plac->Label(
  224.         -text       => "Hash : ",
  225.         -background => $color_fondo,
  226.         -foreground => $color_texto,
  227.         -font       => "Impact1"
  228.     )->place( -x => 10, -y => 30 );
  229.     my $ewa = $plac->Entry(
  230.         -background => $color_fondo,
  231.         -foreground => $color_texto,
  232.         -width      => 33
  233.     )->place( -y => 33, -x => 60 );
  234.     $plac->Button(
  235.         -text             => "Add",
  236.         -background       => $color_fondo,
  237.         -activebackground => $color_texto,
  238.         -foreground       => $color_texto,
  239.         -width            => 7,
  240.         -command          => \&addnowa
  241.     )->place( -y => 33, -x => 275 );
  242.  
  243.     sub addnowa {
  244.         if ( ver_length( $ewa->get ) ) {
  245.             $had->insert( "end", $ewa->get );
  246.         }
  247.         else {
  248.             $ta->Dialog(
  249.                 -title            => "Error",
  250.                 -buttons          => ["OK"],
  251.                 -text             => "Hash invalid",
  252.                 -background       => $color_fondo,
  253.                 -foreground       => $color_texto,
  254.                 -activebackground => $color_texto
  255.             )->Show();
  256.         }
  257.     }
  258. }
  259.  
  260. sub cleanow {
  261.     $had->delete( 0.0, "end" );
  262.     $red->delete( 0.0, "end" );
  263. }
  264.  
  265. sub about {
  266.     $ta->Dialog(
  267.         -title            => "About",
  268.         -buttons          => ["OK"],
  269.         -text             => "This program was coded by Doddy Hackman in 2012",
  270.         -background       => $color_fondo,
  271.         -foreground       => $color_texto,
  272.         -activebackground => $color_text
  273.     )->Show();
  274. }
  275.  
  276. sub salir {
  277.     exit(1);
  278. }
  279.  
  280. sub crackit {
  281.  
  282.     my $target = shift;
  283.  
  284.     chomp $target;
  285.  
  286.     my %hash = (
  287.  
  288.         'http://md5.hashcracking.com/search.php?md5=' => {
  289.             'tipo'  => 'get',
  290.             'regex' => "Cleartext of $target is (.*)",
  291.         },
  292.  
  293.         'http://www.hashchecker.com/index.php?_sls=search_hash' => {
  294.             'variables' => { 'search_field' => $target, 'Submit' => 'search' },
  295.             'regex' =>
  296.               "<td><li>Your md5 hash is :<br><li>$target is <b>(.*)<\/b>",
  297.         },
  298.  
  299.         'http://md5.rednoize.com/?q=' => {
  300.             'tipo'  => 'get',
  301.             'regex' => "<div id=\"result\" >(.*)<\/div>"
  302.         },
  303.  
  304.         'http://md52.altervista.org/index.php?md5=' => {
  305.             'tipo'  => 'get',
  306.             'regex' => "<br>Password: <font color=\"Red\">(.*)<\/font><\/b>"
  307.           }
  308.  
  309.     );
  310.  
  311.     for my $data ( keys %hash ) {
  312.         $ta->update;
  313.         if ( $hash{$data}{tipo} eq "get" ) {
  314.             $code = toma( $data . $target );
  315.             if ( $code =~ /$hash{$data}{regex}/ig ) {
  316.                 my $found = $1;
  317.                 unless ( $found =~ /\[Non Trovata\]/ ) {
  318.                     return $found;
  319.                     last;
  320.                 }
  321.             }
  322.         }
  323.         else {
  324.             $code = tomar( $data, $hash{$data}{variables} );
  325.             if ( $code =~ /$hash{$data}{regex}/ig ) {
  326.                 my $found = $1;
  327.                 return $found;
  328.                 last;
  329.             }
  330.         }
  331.     }
  332.     return "false01";
  333. }
  334.  
  335. sub savefile {
  336.     open( SAVE, ">>" . $_[0] );
  337.     print SAVE $_[1] . "\n";
  338.     close SAVE;
  339. }
  340.  
  341. sub repes {
  342.     my @limpio;
  343.     foreach $test (@_) {
  344.         push @limpio, $test unless $repe{$test}++;
  345.     }
  346.     return @limpio;
  347. }
  348.  
  349. sub ver_length {
  350.     return true if length( $_[0] ) == 32;
  351. }
  352.  
  353. sub toma {
  354.     return $nave->get( $_[0] )->content;
  355. }
  356.  
  357. sub tomar {
  358.     my ( $web, $var ) = @_;
  359.     return $nave->post( $web, [ %{$var} ] )->content;
  360. }
  361.  
  362. #The End ?
  363.  
276  Programación / Scripting / [Perl] Finder Pass 0.3 en: 31 Marzo 2012, 22:46 pm
La nueva version de un programa que habia hecho para crackear hashes md5 mediante paginas online.

Código
  1. #!usr/bin/perl
  2. #Finder Pass 0.3
  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. menu();
  14.  
  15. sub menu {
  16.  
  17.     head();
  18.  
  19.     print "[+] Option : ";
  20.     chomp( my $op = <stdin> );
  21.  
  22.     if ( $op eq "1" ) {
  23.         print "\n\n[+] Hash : ";
  24.         chomp( my $ha = <stdin> );
  25.         if ( ver_length($ha) ) {
  26.             print "\n\n[+] Cracking Hash...\n";
  27.             my $re = crackit($ha);
  28.             unless ( $re =~ /false01/ ) {
  29.                 print "\n[+] Cracked : $re\n\n";
  30.                 savefile( "hashes-found.txt", $ha . ":" . $re );
  31.             }
  32.             else {
  33.                 print "\n[-] Not Found\n\n";
  34.             }
  35.         }
  36.         else {
  37.             print "\n\n[-] Hash invalid\n\n";
  38.         }
  39.         print "\n[+] Finished";
  40.         <stdin>;
  41.         menu();
  42.     }
  43.     if ( $op eq "2" ) {
  44.         print "\n\n[+] Wordlist : ";
  45.         chomp( my $fi = <stdin> );
  46.         if ( -f $fi ) {
  47.             print "\n\n[+] Opening File\n";
  48.             open( WORD, $fi );
  49.             my @varios = <WORD>;
  50.             close WORD;
  51.             my @varios = repes(@varios);
  52.             print "[+] Hashes Found : " . int(@varios);
  53.             print "\n\n[+] Cracking hashes...\n\n";
  54.             for $hash (@varios) {
  55.                 chomp $hash;
  56.                 if ( ver_length($hash) ) {
  57.                     my $re = crackit($hash);
  58.                     unless ( $re =~ /false01/ ) {
  59.                         print "[+] $hash : $re\n";
  60.                         savefile( "hashes-found.txt", $hash . ":" . $re );
  61.                     }
  62.                 }
  63.             }
  64.         }
  65.         else {
  66.             print "\n\n[-] File Not Found\n\n";
  67.         }
  68.         print "\n[+] Finished";
  69.         <stdin>;
  70.         menu();
  71.     }
  72.     if ( $op eq "3" ) {
  73.         copyright();
  74.     }
  75. }
  76.  
  77. sub crackit {
  78.  
  79.     my $target = shift;
  80.  
  81.     chomp $target;
  82.  
  83.     my %hash = (
  84.  
  85.         'http://md5.hashcracking.com/search.php?md5=' => {
  86.             'tipo'  => 'get',
  87.             'regex' => "Cleartext of $target is (.*)",
  88.         },
  89.  
  90.         'http://www.hashchecker.com/index.php?_sls=search_hash' => {
  91.             'variables' => { 'search_field' => $target, 'Submit' => 'search' },
  92.             'regex' =>
  93.               "<td><li>Your md5 hash is :<br><li>$target is <b>(.*)<\/b>",
  94.         },
  95.  
  96.         'http://md5.rednoize.com/?q=' => {
  97.             'tipo'  => 'get',
  98.             'regex' => "<div id=\"result\" >(.*)<\/div>"
  99.         },
  100.  
  101.         'http://md52.altervista.org/index.php?md5=' => {
  102.             'tipo'  => 'get',
  103.             'regex' => "<br>Password: <font color=\"Red\">(.*)<\/font><\/b>"
  104.           }
  105.  
  106.     );
  107.  
  108.     for my $data ( keys %hash ) {
  109.         if ( $hash{$data}{tipo} eq "get" ) {
  110.             $code = toma( $data . $target );
  111.             if ( $code =~ /$hash{$data}{regex}/ig ) {
  112.                 my $found = $1;
  113.                 unless ( $found =~ /\[Non Trovata\]/ ) {
  114.                     return $found;
  115.                     last;
  116.                 }
  117.             }
  118.         }
  119.         else {
  120.             $code = tomar( $data, $hash{$data}{variables} );
  121.             if ( $code =~ /$hash{$data}{regex}/ig ) {
  122.                 my $found = $1;
  123.                 return $found;
  124.                 last;
  125.             }
  126.         }
  127.     }
  128.     return "false01";
  129. }
  130.  
  131. sub copyright {
  132.     print "\n\n(C) Doddy Hackman 2012\n";
  133.     <stdin>;
  134.     exit(1);
  135. }
  136.  
  137. sub head {
  138.     print qq(
  139.  
  140.  
  141. ##########  #########  #########     #####   #    ###  ###
  142.  #  # #  ##  #  #   #   #  # #  #     #  #   #   #  # #  #
  143.  #    #  ##  #  #    #  #    #  #     #  #  # #  #    #   
  144.  ###  #  # # #  #    #  ###  ###      ###   # #   ##   ## 
  145.  #    #  # # #  #    #  #    # #      #    #####    #    #
  146.  #    #  #  ##  #   #   #  # #  #     #    #   # #  # #  #
  147. ###  ######  # #####   ########  #   ###  ### ######  ### 
  148.  
  149.  
  150.  
  151.  
  152. [++] Options
  153.  
  154.  
  155. [+] 1 : Hash
  156. [+] 2 : File with hashes
  157. [+] 3 : Exit 
  158.  
  159.  
  160. );
  161. }
  162.  
  163. sub savefile {
  164.     open( SAVE, ">>" . $_[0] );
  165.     print SAVE $_[1] . "\n";
  166.     close SAVE;
  167. }
  168.  
  169. sub repes {
  170.     my @limpio;
  171.     foreach $test (@_) {
  172.         push @limpio, $test unless $repe{$test}++;
  173.     }
  174.     return @limpio;
  175. }
  176.  
  177. sub ver_length {
  178.     return true if length( $_[0] ) == 32;
  179. }
  180.  
  181. sub toma {
  182.     return $nave->get( $_[0] )->content;
  183. }
  184.  
  185. sub tomar {
  186.     my ( $web, $var ) = @_;
  187.     return $nave->post( $web, [ %{$var} ] )->content;
  188. }
  189.  
  190. #The End ?
  191.  
277  Programación / Scripting / [Perl Tk] Lix.In Decoder 0.2 en: 28 Marzo 2012, 22:57 pm
Hola a todos.

Aca les traigo la version Tk de un script que habia hecho para decodificar las url lix.in

Lo bueno del programa es que guarda todo los logs en la carpeta donde ejecutaron el programa

Una imagen del programa seria


Código
  1. #!usr/bin/perl
  2. #Lix.In Decoder 0.2
  3. #Version Tk
  4. #Coded By Doddy H
  5.  
  6. use LWP::UserAgent;
  7. use URI::Split qw(uri_split);
  8. use Tk;
  9. use Tk::Dialog;
  10.  
  11. #if ( $^O eq 'MSWin32' ) {
  12. #    use Win32::Console;
  13. #    Win32::Console::Free();
  14. #}
  15.  
  16. my $nave = LWP::UserAgent->new;
  17. $nave->agent(
  18. "Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
  19. );
  20. $nave->timeout(5);
  21.  
  22. my $color_fondo = "black";
  23. my $color_text  = "green";
  24.  
  25. my $ben =
  26.   MainWindow->new( -background => $color_fondo, -foreground => $color_text );
  27.  
  28. $ben->title("Lix.In Decoder 0.2 (C) Doddy Hackman 2012");
  29. $ben->geometry("492x385+20+20");
  30. $ben->resizable( 0, 0 );
  31.  
  32. $ben->Label(
  33.     -background => $color_fondo,
  34.     -foreground => $color_text,
  35.     -text       => "Page : ",
  36.     -font       => "Impact1"
  37. )->place( -x => 20, -y => 20 );
  38. my $page = $ben->Entry(
  39.     -background => $color_fondo,
  40.     -foreground => $color_text,
  41.     -width      => 40
  42. )->place( -x => 73, -y => 24 );
  43.  
  44. $ben->Button(
  45.     -text             => "Decode",
  46.     -width            => 10,
  47.     -command          => \&home,
  48.     -background       => $color_fondo,
  49.     -foreground       => $color_text,
  50.     -activebackground => $color_text
  51. )->place( -x => 325, -y => 23 );
  52. $ben->Button(
  53.     -text             => "Logs",
  54.     -width            => 10,
  55.     -command          => \&logs,
  56.     -background       => $color_fondo,
  57.     -foreground       => $color_text,
  58.     -activebackground => $color_text
  59. )->place( -x => 400, -y => 23 );
  60.  
  61. $ben->Label(
  62.     -text       => "Links Found",
  63.     -font       => "Impact",
  64.     -background => $color_fondo,
  65.     -foreground => $color_text
  66. )->place( -x => 200, -y => 80 );
  67. my $links = $ben->Listbox(
  68.     -width      => 70,
  69.     -height     => 15,
  70.     -background => $color_fondo,
  71.     -foreground => $color_text
  72. )->place( -x => 32, -y => 140 );
  73.  
  74. MainLoop;
  75.  
  76. sub home {
  77.  
  78.     $links->delete( "0.0", "end" );
  79.  
  80.     my $url = $page->get;
  81.  
  82.     my $code = toma($url);
  83.  
  84.     while ( $code =~ m{http://lix\.in/(-\w+)}ig ) {
  85.         push( @urls, "http://lix.in/" . $1 );
  86.     }
  87.  
  88.     while ( $code =~ m{http://lix\.in/(\w+)}ig ) {
  89.         push( @urls, "http://lix.in/-" . $1 );
  90.     }
  91.  
  92.     my @urls = repes(@urls);
  93.  
  94.     for my $l (@urls) {
  95.         chomp $l;
  96.         $ben->update;
  97.         decode_link( $l, $url );
  98.     }
  99. }
  100.  
  101. sub decode_link {
  102.  
  103.     my ( $link, $url ) = @_;
  104.  
  105.     my ( $scheme, $auth, $path, $query, $frag ) = uri_split($url);
  106.  
  107.     if ( $link =~ /-(.*)/ ) {
  108.         my $co = "-" . $1;
  109.         chomp $co;
  110.         my $code =
  111.           tomar( $link,
  112.             { "tiny" => $co, "submit" => "continue", "submit" => "submit" } );
  113.         if ( $code =~ /<iframe  name="ifram" src="(.*)" marginwidth="0"/ ) {
  114.             my $link = $1;
  115.             chomp $link;
  116.             unless ( $link =~ /lix\.in/ ) {
  117.                 savefile( $auth . ".txt", $link );
  118.                 $links->insert( "end", $link );
  119.             }
  120.         }
  121.     }
  122. }
  123.  
  124. sub logs {
  125.  
  126.     my ( $scheme, $auth, $path, $query, $frag ) = uri_split( $page->get );
  127.     my $f = $auth . ".txt";
  128.  
  129.     if ( -f $f ) {
  130.         system($f);
  131.     }
  132.     else {
  133.         $ben->Dialog(
  134.             -title            => "Error",
  135.             -buttons          => ["OK"],
  136.             -text             => "Logs not found",
  137.             -background       => $color_fondo,
  138.             -foreground       => $color_text,
  139.             -activebackground => $color_text
  140.         )->Show();
  141.     }
  142. }
  143.  
  144. sub repes {
  145.     my @limpio;
  146.     foreach $test (@_) {
  147.         push @limpio, $test unless $repe{$test}++;
  148.     }
  149.     return @limpio;
  150. }
  151.  
  152. sub savefile {
  153.     open( SAVE, ">>" . $_[0] );
  154.     print SAVE $_[1] . "\n";
  155.     close SAVE;
  156. }
  157.  
  158. sub toma {
  159.     return $nave->get( $_[0] )->content;
  160. }
  161.  
  162. sub tomar {
  163.     my ( $web, $var ) = @_;
  164.     return $nave->post( $web, [ %{$var} ] )->content;
  165. }
  166.  
  167. # The End ?
  168.  
  169.  
278  Programación / Scripting / [Perl] Lix In Decoder 0.1 en: 26 Marzo 2012, 19:45 pm
Bueno , hice este programa para poder descargar juegos cuando entraba en una pagina y veia que todos los links estaban en lix.in , para usar este programa deben poner la url de la pagina que tiene los links lix.in , el programa automaticamente captura todos los links de la pagina y comienza a mostrar las verdaderas urls en pantalla.
Al parecer no eh tenido ningun problema con ningun Captcha , puesto que lo eh probado varias veces en diferentes paginas.

El codigo es el siguiente

Código
  1. #!usr/bin/perl
  2. #Lix.In Decoder 0.1
  3. #Coded By Doddy H
  4.  
  5. use LWP::UserAgent;
  6. use URI::Split qw(uri_split);
  7.  
  8. my $nave = LWP::UserAgent->new;
  9. $nave->agent(
  10. "Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
  11. );
  12. $nave->timeout(5);
  13.  
  14. #Tests
  15. #my $url = "http://taringaa.bligoo.com/content/view/858363/Comand-Conquer-Red-Alert-III-Full-1-link.html";
  16. #my $url = "http://www.taringa.net/posts/animaciones/4164567.R/Saint-Seiya-Mei_-Hades-ElysionHen_Campos-Eliseos_-Vol-10_11.html";
  17. #my $url = "http://www.gratisjuegos.org/descargar/muchos-juegos-en-pocos-links/";
  18. #my $url = "http://eminemdownloads.blogspot.com.ar/2007/03/discografia.html";
  19.  
  20. ##
  21.  
  22. header();
  23.  
  24. print "\n[+] Page : ";
  25. chomp( my $url = <stdin> );
  26.  
  27. print "\n\n[+] Loading page ...\n";
  28.  
  29. my $code = toma($url);
  30.  
  31. print "[+] Getting links ...\n";
  32.  
  33. while ( $code =~ m{http://lix\.in/(-\w+)}ig ) {
  34.     push( @urls, "http://lix.in/" . $1 );
  35. }
  36.  
  37. while ( $code =~ m{http://lix\.in/(\w+)}ig ) {
  38.     push( @urls, "http://lix.in/-" . $1 );
  39. }
  40.  
  41. print "[+] Decoding links lix.in ....\n\n";
  42.  
  43. my @urls = repes(@urls);
  44.  
  45. for (@urls) {
  46.     decode_link( $_, $url );
  47. }
  48.  
  49. copyright();
  50.  
  51. ##
  52.  
  53. sub decode_link {
  54.  
  55.     my ( $link, $url ) = @_;
  56.  
  57.     my ( $scheme, $auth, $path, $query, $frag ) = uri_split($url);
  58.  
  59.     if ( $link =~ /-(.*)/ ) {
  60.         my $co = "-" . $1;
  61.         chomp $co;
  62.         my $code =
  63.           tomar( $link,
  64.             { "tiny" => $co, "submit" => "continue", "submit" => "submit" } );
  65.         if ( $code =~ /<iframe  name="ifram" src="(.*)" marginwidth="0"/ ) {
  66.             my $link = $1;
  67.             chomp $link;
  68.             unless ( $link =~ /lix\.in/ ) {
  69.                 savefile( $auth . ".txt", $link );
  70.                 print "[+] Link : $link\n";
  71.             }
  72.         }
  73.     }
  74. }
  75.  
  76. sub repes {
  77.     foreach $test (@_) {
  78.         push @limpio, $test unless $repe{$test}++;
  79.     }
  80.     return @limpio;
  81. }
  82.  
  83. sub header {
  84.  
  85.     print qq(
  86.  
  87.  
  88.  @     @         @           @@@@                          @         
  89.  @               @           @   @                         @         
  90.  @               @           @    @                        @         
  91.  @     @ @  @    @  @ @@     @    @   @@@   @@@   @@@   @@@@  @@@  @@
  92.  @     @ @  @    @  @@  @    @    @  @   @ @   @ @   @ @   @ @   @ @ 
  93.  @     @  @@     @  @   @    @    @  @@@@@ @     @   @ @   @ @@@@@ @ 
  94.  @     @  @@     @  @   @    @    @  @     @     @   @ @   @ @     @ 
  95.  @     @ @  @    @  @   @    @   @   @   @ @   @ @   @ @   @ @   @ @ 
  96.  @@@@@ @ @  @    @  @   @    @@@@     @@@   @@@   @@@   @@@@  @@@  @ 
  97.  
  98.  
  99. );
  100.  
  101. }
  102.  
  103. sub savefile {
  104.     open( SAVE, ">>" . $_[0] );
  105.     print SAVE $_[1] . "\n";
  106.     close SAVE;
  107. }
  108.  
  109. sub copyright {
  110.     print "\n\n(C) Doddy Hackman 2012\n\n";
  111.     <stdin>;
  112.     exit(1);
  113. }
  114.  
  115. sub toma {
  116.     return $nave->get( $_[0] )->content;
  117. }
  118.  
  119. sub tomar {
  120.     my ( $web, $var ) = @_;
  121.     return $nave->post( $web, [ %{$var} ] )->content;
  122. }
  123.  
  124. # The End ?
  125.  

Les dejo un ejemplo de uso

Código:


 @     @         @           @@@@                          @
 @               @           @   @                         @
 @               @           @    @                        @
 @     @ @  @    @  @ @@     @    @   @@@   @@@   @@@   @@@@  @@@  @@
 @     @ @  @    @  @@  @    @    @  @   @ @   @ @   @ @   @ @   @ @
 @     @  @@     @  @   @    @    @  @@@@@ @     @   @ @   @ @@@@@ @
 @     @  @@     @  @   @    @    @  @     @     @   @ @   @ @     @
 @     @ @  @    @  @   @    @   @   @   @ @   @ @   @ @   @ @   @ @
 @@@@@ @ @  @    @  @   @    @@@@     @@@   @@@   @@@   @@@@  @@@  @



[+] Page : http://www.gratisjuegos.org/descargar/muchos-juegos-en-pocos-links/


[+] Loading page ...
[+] Getting links ...
[+] Decoding links lix.in ....

[+] Link : http://www.fileserve.com/file/4UauNpZ
[+] Link : http://www.megaupload.com/?d=JDJOXNCG
[+] Link : http://www.megaupload.com/?d=DOIPB44O
[+] Link : http://turbobit.net/u1savmp0dp82/BaixandoFacil.com_Raising.Hope.S02E1
5.rmvb.html
[+] Link : http://www.megaupload.com/?d=TWZXM4OA
[+] Link : http://rapidshare.com/files/326639218/mmph.rar
[+] Link : http://uploading.com/files/8m55a3e9/Hitomi%2527s%2BCherry%2BRed%2BLip
s%2B%255BSasagawa%2BHayashi%255D.rar/
[+] Link : http://protector.to/download/296576/66637b4defe247e6b465c15b6daadb88.
html
[+] Link : http://rapidshare.com/files/222173802/Hiroshima_Will_Burn_-_To_The_We
ight_Of_All_Things_-__2009__By_Disgorge.rar
[+] Link : http://www.megaupload.com/?d=ILUL67F0
[+] Link : http://rapidshare.com/files/168921368/Ab_-_2006_-_T_D_P_-_melodeath.o
rg.rar
[+] Link : http://rapidshare.com/files/206107948/aHD_GArt_1_LuFr_wm.part1.rar
[+] Link : http://rapidshare.com/files/144375887/B.WoLF.MtbX.part07.rar
[+] Link : http://rapidshare.com/files/202336513/Die__rzte__Wir_wollen_nur_deine
_Seele_I_.rar.html
[+] Link : http://rapidshare.com/files/310131228/ls_cta_01.part1.rar
[+] Link : http://rapidshare.com/files/117343572/georemichahshootdo.rar
[+] Link : http://www.megaupload.com/?d=3JGC8I3J
[+] Link : http://repidshare.uni.cc/up/files.php?rs=http://rs.rapidshare.com/fil
es/121698550/www.xvidfilm.com_shtrr.HD.tr_barlas.part22.rar&amp;s=
[+] Link : http://rapidshare.com/files/379279204/bndpq__smscl_rmntcincrble.karma
.rar
[+] Link : http://www.megaupload.com/?d=ES5U6KVW
[+] Link : http://turbobit.net/hxombgi9wguf.html
[+] Link : http://hotfile.com/dl/38699729/4dbfbdf/Brothers.Sisters.2x01.by.www.s
eriesfree.biz.rmvb.html
[+] Link : http://www.filesonic.jp/file/1542896624
[+] Link : http://rapidshare.com/files/251767677/Knowing_Blurayindir.com.part122
.rar
[+] Link : http://img199.imageshack.us/img199/5452/lastsamurai.jpg
[+] Link : http://www.megaupload.com/?d=AAG4X8X2
[+] Link : http://ul.to/8hkfdh
[+] Link : http://hotfile.com/dl/594136/1934718/My.Name.Is.Earl.S04E24.HDTV.XviD
-LOL.avi.html
[+] Link : http://hotfile.com/dl/31792875/9882fa9/chandelier_jpn.rar.html
[+] Link : http://www.megaupload.com/?d=PV6BJMHJ
[+] Link : http://rapidshare.com/files/163195270/the_killers.rar
[+] Link : http://repidshare.uni.cc/up/files.php?rs=http://rs110.rapidshare.com/
files/88759448/TamGaz.part5.rar&amp;s=104857
[+] Link : http://rapidshare.com/files/183553695/Anita_Pearl_Little_Red_In_The_O
ffice.rar


(C) Doddy Hackman 2012
279  Programación / Scripting / [Perl Tk] LocateIP 0.4 en: 24 Marzo 2012, 22:53 pm
Un simple programa en Perl que sirve para buscar informacion sobre una IP , primero busca la localizacion y despues busca las DNS relacionadas.

Les dejo una imagen del programa


El codigo (formateado con perltidy) es

Código
  1. #!usr/bin/perl
  2. #Locate IP 0.4
  3. #Version Tk
  4. #Coded By Doddy H
  5.  
  6. use Tk;
  7. use LWP::UserAgent;
  8. use IO::Socket;
  9.  
  10. my $background_color = "black";
  11. my $texto_color      = "green";
  12.  
  13. if ( $^O eq 'MSWin32' ) {
  14.     use Win32::Console;
  15.     Win32::Console::Free();
  16. }
  17.  
  18. installer();
  19.  
  20. my $nave = LWP::UserAgent->new;
  21. $nave->agent(
  22. "Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
  23. );
  24. $nave->timeout(5);
  25.  
  26. $p = MainWindow->new(
  27.     -background => $background_color,
  28.     -foreground => $texto_color
  29. );
  30. $p->title("Locate IP 0.4 || Coded By Doddy H");
  31. $p->geometry("440x300+20+20");
  32. $p->resizable( 0, 0 );
  33.  
  34. $p->Label(
  35.     -text       => "Target : ",
  36.     -font       => "Impact",
  37.     -background => $background_color,
  38.     -foreground => $texto_color
  39. )->place( -x => 20, -y => 20 );
  40. my $tar = $p->Entry(
  41.     -width      => 30,
  42.     -background => $background_color,
  43.     -foreground => $texto_color
  44. )->place( -y => 24, -x => 80 );
  45. $p->Button(
  46.     -text             => "Find",
  47.     -width            => 10,
  48.     -background       => $background_color,
  49.     -foreground       => $texto_color,
  50.     -activebackground => $texto_color,
  51.     -command          => \&st
  52. )->place( -y => 23, -x => 272 );
  53. $p->Button(
  54.     -text       => "Logs",
  55.     -width      => 10,
  56.     -background => $background_color,
  57.     -foreground => $texto_color,
  58.     ,
  59.     -activebackground => $texto_color,
  60.     -command          => \&openlogs
  61. )->place( -y => 23, -x => 350 );
  62.  
  63. $p->Label(
  64.     -text       => "Information",
  65.     -font       => "Impact",
  66.     -background => $background_color,
  67.     -foreground => $texto_color
  68. )->place( -x => 80, -y => 80 );
  69.  
  70. $p->Label(
  71.     -text       => "City : ",
  72.     -font       => "Impact1",
  73.     -background => $background_color,
  74.     -foreground => $texto_color
  75. )->place( -y => 140, -x => 23 );
  76. my $city = $p->Entry(
  77.     -width      => 21,
  78.     -background => $background_color,
  79.     -foreground => $texto_color
  80. )->place( -y => 143, -x => 65 );
  81.  
  82. $p->Label(
  83.     -text       => "Country : ",
  84.     -font       => "Country",
  85.     -background => $background_color,
  86.     -foreground => $texto_color
  87. )->place( -y => 170, -x => 23 );
  88. my $country = $p->Entry(
  89.     -width      => 17,
  90.     -background => $background_color,
  91.     -foreground => $texto_color
  92. )->place( -y => 173, -x => 90 );
  93.  
  94. $p->Label(
  95.     -text       => "State : ",
  96.     -font       => "Impact1",
  97.     -background => $background_color,
  98.     -foreground => $texto_color
  99. )->place( -y => 200, -x => 23 );
  100. my $state = $p->Entry(
  101.     -width      => 20,
  102.     -background => $background_color,
  103.     -foreground => $texto_color
  104. )->place( -y => 203, -x => 75 );
  105.  
  106. $p->Label(
  107.     -text       => "DNS Found",
  108.     -font       => "Impact",
  109.     -background => $background_color,
  110.     -foreground => $texto_color
  111. )->place( -y => 80, -x => 285 );
  112. my $dns = $p->Listbox(
  113.     -width      => 30,
  114.     -background => $background_color,
  115.     -foreground => $texto_color
  116. )->place( -x => 230, -y => 130 );
  117.  
  118. MainLoop;
  119.  
  120. sub st {
  121.  
  122.     $city->configure( -text => " " );
  123.     $country->configure( -text => " " );
  124.     $state->configure( -text => " " );
  125.     $dns->delete( "0.0", "end" );
  126.  
  127.     my $target = $tar->get;
  128.  
  129.     savefile( "info-logs.txt", "[+] Target : $target" );
  130.  
  131.     my $get    = gethostbyname($target);
  132.     my $target = inet_ntoa($get);
  133.  
  134.     savefile( "info-logs.txt", "[+] IP : $target\n" );
  135.  
  136.     $total =
  137.       "http://www.melissadata.com/lookups/iplocation.asp?ipaddress=$target";
  138.  
  139.     $re = toma($total);
  140.  
  141.     if ( $re =~ /City<\/td><td align=(.*)><b>(.*)<\/b><\/td>/ ) {
  142.         savefile( "info-logs.txt", "[+] City : $2" );
  143.         $city->configure( -text => $2 );
  144.     }
  145.     else {
  146.         $city->configure( -text => "Not Found" );
  147.     }
  148.     if ( $re =~ /Country<\/td><td align=(.*)><b>(.*)<\/b><\/td>/ ) {
  149.         savefile( "info-logs.txt", "[+] Country : $2" );
  150.         $country->configure( -text => $2 );
  151.         print "[+] Country : $2\n";
  152.     }
  153.     else {
  154.         $country->configure( -text => "Not Found" );
  155.     }
  156.     if ( $re =~ /State or Region<\/td><td align=(.*)><b>(.*)<\/b><\/td>/ ) {
  157.         savefile( "info-logs.txt", "[+] State of Region : $2" );
  158.         $state->configure( -text => $2 );
  159.     }
  160.     else {
  161.         $state->configure( -text => "Not Found" );
  162.     }
  163.  
  164.     my $code = toma( "http://www.ip-adress.com/reverse_ip/" . $target );
  165.  
  166.     savefile( "info-logs.txt", "" );
  167.  
  168.     while ( $code =~ /whois\/(.*?)\">Whois/g ) {
  169.         my $dnsa = $1;
  170.         chomp $dnsa;
  171.         savefile( "info-logs.txt", "[+] DNS Found : $dnsa" );
  172.         $dns->insert( "end", $dnsa );
  173.     }
  174.     savefile( "info-logs.txt", "\n######################\n" );
  175. }
  176.  
  177. sub openlogs {
  178.     system("start logs/info-logs.txt");
  179. }
  180.  
  181. sub installer {
  182.     unless ( -d "/logs" ) {
  183.         mkdir( "logs/", 777 );
  184.     }
  185. }
  186.  
  187. sub savefile {
  188.     open( SAVE, ">>logs/" . $_[0] );
  189.     print SAVE $_[1] . "\n";
  190.     close SAVE;
  191. }
  192.  
  193. sub toma {
  194.     return $nave->get( $_[0] )->content;
  195. }
  196.  
  197. #The End ?
  198.  
280  Programación / Scripting / [Perl Tk] Diccionario Online 0.1 en: 19 Marzo 2012, 02:05 am
Mientras estudiaba para unos examenes estaba buscando la definicion de algunas palabras asi que me hice este pequeño programa en perl para poder buscar la definicion de cualquier palabra mediante una pagina web.

Una imagen


El codigo

Código
  1. #!usr/bin/perl
  2. #Diccionario Online 0.1
  3. #Coded By Doddy H
  4.  
  5. use Tk;
  6. use Tk::ROText;
  7. use LWP::UserAgent;
  8. use HTML::Entities;
  9.  
  10. if ( $^O eq 'MSWin32' ) {
  11.     use Win32::Console;
  12.     Win32::Console::Free();
  13. }
  14.  
  15. my $nave = LWP::UserAgent->new;
  16. $nave->agent(
  17. "Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
  18. );
  19. $nave->timeout(5);
  20.  
  21. my $fondo = "gray";
  22. my $letra = "black";
  23.  
  24. my $new = MainWindow->new( -background => $fondo, -foreground => $letra );
  25.  
  26. $new->title("Diccinario Online 0.1 || By Doddy H");
  27. $new->geometry("340x290+20+20");
  28. $new->resizable( 0, 0 );
  29.  
  30. $new->Label(
  31.     -text       => "Palabra : ",
  32.     -font       => "Impact1",
  33.     -background => $fondo,
  34.     -foreground => $letra
  35. )->place( -x => 20, -y => 20 );
  36. my $pal =
  37.   $new->Entry( -width => 25, -background => $fondo, -foreground => $letra )
  38.   ->place( -x => 95, -y => 24 );
  39. $new->Button(
  40.     -text             => "Buscar",
  41.     -width            => 7,
  42.     -background       => $fondo,
  43.     -foreground       => $letra,
  44.     -activebackground => $fondo,
  45.     -command          => \&start
  46. )->place( -y => 22, -x => 260 );
  47.  
  48. $new->Label(
  49.     -text       => "Significado",
  50.     -font       => "Impact1",
  51.     -background => $fondo,
  52.     -foreground => $letra
  53. )->place( -x => 120, -y => 70 );
  54. my $con = $new->ROText(
  55.     width       => 39,
  56.     -height     => 10,
  57.     -background => $fondo,
  58.     -foreground => $letra
  59. )->place( -x => 30, -y => 120 );
  60.  
  61. MainLoop;
  62.  
  63. sub start {
  64.  
  65.     $new->update;
  66.     $con->delete( "0.0", "end" );
  67.  
  68.     my $code = toma( "http://es.thefreedictionary.com/" . $pal->get );
  69.  
  70.     chomp $code;
  71.  
  72.     if ( $code =~ /<div class=runseg><b>1 <\/b>&nbsp; (.*?)[.:<]/ ) {
  73.         my $text = decode_entities($1);
  74.         $con->insert( "end", $text );
  75.     }
  76.  
  77. }
  78.  
  79. sub toma {
  80.     return $nave->get( $_[0] )->content;
  81. }
  82.  
  83. #The End ?
  84.  
  85.  
Páginas: 1 ... 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 [28] 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines