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

 

 


Tema destacado: Como proteger una cartera - billetera de Bitcoin


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


Desconectado Desconectado

Mensajes: 545



Ver Perfil
[Perl] FindIcons 0.1
« en: 25 Noviembre 2012, 23:24 pm »

Un simple script para bajar los iconos que quieran , los iconos bajados se guardan en un carpeta con el nombre buscado.

Código
  1. #!usr/bin/perl
  2. #FindIcons 0.1
  3. #Coded By Doddy H
  4.  
  5. use LWP::UserAgent;
  6. use URI::Split qw(uri_split);
  7. use Time::HiRes "usleep";
  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. head();
  16.  
  17. print "[?] Search : ";
  18. chomp( my $se = <stdin> );
  19.  
  20. $se =~ s/ /-/;
  21.  
  22. my $code = toma( "http://findicons.com/search/" . $se );
  23.  
  24. if ( $code =~ /<div class="box_info left">(.*)<\/div>/ ) {
  25.    print "\n[+] $1\n";
  26.  
  27.    unless ( -d $se ) {
  28.        mkdir( $se, "777" );
  29.    }
  30.  
  31.    chdir $se;
  32.  
  33. }
  34. else {
  35.    print "\n[-] Not Found\n";
  36.    copyright();
  37. }
  38.  
  39. print "\n[?] Pages : ";
  40.  
  41. chomp( my $pages = <stdin> );
  42.  
  43. print "\n[+] Downloading ...\n\n";
  44.  
  45. for my $pages ( 1 .. $pages ) {
  46.  
  47.    my $code = toma("http://findicons.com/search/$se/$pages");
  48.  
  49.    while ( $code =~
  50.        /<img src="http:\/\/png-(.*).findicons.com\/files\/(.*)" alt/mig )
  51.    {
  52.        my $link = "http://png-" . $1 . ".findicons.com/files/" . $2;
  53.  
  54.        now($link);
  55.  
  56.    }
  57.  
  58. }
  59.  
  60. print "[+] Finished ...\n";
  61.  
  62. copyright();
  63.  
  64. sub head {
  65.  
  66.    my @logo = (
  67.        "#=============================================#", "\n",
  68.        "#              FindIcons 0.1                  #", "\n",
  69.        "#---------------------------------------------#", "\n",
  70.        "# Written By Doddy H                          #", "\n",
  71.        "# Email: lepuke[at]hotmail[com]               #", "\n",
  72.        "# Website: doddyhackman.webcindario.com       #", "\n",
  73.        "#---------------------------------------------#", "\n",
  74.        "# The End ?                                   #", "\n",
  75.        "#=============================================#", "\n"
  76.    );
  77.  
  78.    print "\n";
  79.  
  80.    marquesina(@logo);
  81.  
  82.    print "\n\n";
  83.  
  84. }
  85.  
  86. sub copyright {
  87.  
  88.    my @fin = ("-- == (C) Doddy Hackman 2012 == --");
  89.  
  90.    print "\n\n";
  91.    marquesina(@fin);
  92.    print "\n\n";
  93.  
  94.    <stdin>;
  95.  
  96.    exit(1);
  97.  
  98. }
  99.  
  100. sub marquesina {
  101.  
  102.    #Effect based in the exploits by Jafer Al Zidjali
  103.  
  104.    my @logo = @_;
  105.  
  106.    my $car = "|";
  107.  
  108.    for my $uno (@logo) {
  109.        for my $dos ( split //, $uno ) {
  110.  
  111.            $|++;
  112.  
  113.            if ( $car eq "|" ) {
  114.                mostrar( "\b" . $dos . $car, "/" );
  115.            }
  116.            elsif ( $car eq "/" ) {
  117.                mostrar( "\b" . $dos . $car, "-" );
  118.            }
  119.            elsif ( $car eq "-" ) {
  120.                mostrar( "\b" . $dos . $car, "\\" );
  121.            }
  122.            else {
  123.                mostrar( "\b" . $dos . $car, "|" );
  124.            }
  125.            usleep(40_000);
  126.        }
  127.        print "\b ";
  128.    }
  129.  
  130.    sub mostrar {
  131.        print $_[0];
  132.        $car = $_[1];
  133.    }
  134.  
  135. }
  136.  
  137. sub now {
  138.  
  139.    my ( $scheme, $auth, $path, $query, $frag ) = uri_split( $_[0] );
  140.  
  141.    if ( $path =~ /(.*)\/(.*)$/ ) {
  142.        my $file = $2;
  143.        if ( download( $_[0], $file ) ) {
  144.        }
  145.    }
  146. }
  147.  
  148. sub download {
  149.    if ( $nave->mirror( $_[0], $_[1] ) ) {
  150.        if ( -f $_[1] ) {
  151.            return true;
  152.        }
  153.    }
  154. }
  155.  
  156. sub toma {
  157.    return $nave->get( $_[0] )->content;
  158. }
  159.  
  160. #The End ?
  161.  


En línea

Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.822



Ver Perfil
Re: [Perl] FindIcons 0.1
« Respuesta #1 en: 25 Noviembre 2012, 23:44 pm »

Hola Doddy, buenisimo code

¿Sabes si hay alguna palabra clave para encontrar TODOS los resultados de la web?, Es decir, para bajar la página ENTERA.

He probado con el asterisco "*" pero dice que la palabra es muy corta jeje, lo mismo si pongo "a", "b", etc...

EDITO: Bueno casi que para bajarla entera mejor sería usar algún "WebDownloader:xD

Gracias por el code!


En línea

BigBear


Desconectado Desconectado

Mensajes: 545



Ver Perfil
Re: [Perl] FindIcons 0.1
« Respuesta #2 en: 26 Noviembre 2012, 00:05 am »

ni idea solo la use para buscar los iconos del msn.
En línea

Danyfirex


Desconectado Desconectado

Mensajes: 493


My Dear Mizuho


Ver Perfil
Re: [Perl] FindIcons 0.1
« Respuesta #3 en: 26 Noviembre 2012, 00:39 am »

Muy bonito código y muy útil.  gracias

En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
perl
Scripting
nobo 0 3,197 Último mensaje 22 Febrero 2005, 07:49 am
por nobo
Perl
Scripting
zhynar_X 2 2,226 Último mensaje 12 Enero 2008, 04:36 am
por GroK
-=PERL=-
Scripting
D4RIO 1 5,713 Último mensaje 25 Febrero 2008, 17:27 pm
por D4RIO
MSN Perl y PHP
Scripting
isseu 0 2,673 Último mensaje 30 Diciembre 2008, 14:36 pm
por isseu
Libros de Perl online [PERL]
Scripting
madpitbull_99 0 3,835 Último mensaje 18 Mayo 2011, 21:49 pm
por madpitbull_99
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines