Título: [Perl] FindIcons 0.1
Publicado por: BigBear 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. #!usr/bin/perl #FindIcons 0.1 #Coded By Doddy H use LWP::UserAgent; use URI ::Split qw(uri_split ); use Time::HiRes "usleep"; my $nave = LWP::UserAgent->new; $nave->agent( "Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12" ); $nave->timeout(5); head(); chomp( my $se = <stdin> ); $se =~ s/ /-/; my $code = toma( "http://findicons.com/search/" . $se ); if ( $code =~ /<div class="box_info left">(.*)<\/div>/ ) { unless ( -d $se ) { } } else { print "\n[-] Not Found\n"; copyright(); } chomp( my $pages = <stdin> ); print "\n[+] Downloading ...\n\n"; for my $pages ( 1 .. $pages ) { my $code = toma("http://findicons.com/search/$se/$pages"); while ( $code =~ /<img src="http:\/\/png-(.*).findicons.com\/files\/(.*)" alt/mig ) { my $link = "http://png-" . $1 . ".findicons.com/files/" . $2; now($link); } } print "[+] Finished ...\n"; copyright(); sub head { my @logo = ( "#=============================================#", "\n", "# FindIcons 0.1 #", "\n", "#---------------------------------------------#", "\n", "# Written By Doddy H #", "\n", "# Email: lepuke[at]hotmail[com] #", "\n", "# Website: doddyhackman.webcindario.com #", "\n", "#---------------------------------------------#", "\n", "# The End ? #", "\n", "#=============================================#", "\n" ); marquesina(@logo); } sub copyright { my @fin = ("-- == (C) Doddy Hackman 2012 == --"); marquesina(@fin); <stdin>; } sub marquesina { #Effect based in the exploits by Jafer Al Zidjali my @logo = @_; my $car = "|"; for my $uno (@logo) { for my $dos ( split //, $uno ) { $|++; if ( $car eq "|" ) { mostrar( "\b" . $dos . $car, "/" ); } elsif ( $car eq "/" ) { mostrar( "\b" . $dos . $car, "-" ); } elsif ( $car eq "-" ) { mostrar( "\b" . $dos . $car, "\\" ); } else { mostrar( "\b" . $dos . $car, "|" ); } usleep(40_000); } } sub mostrar { $car = $_[1]; } } sub now { my ( $scheme, $auth, $path, $query, $frag ) = uri_split( $_[0] ); if ( $path =~ /(.*)\/(.*)$/ ) { my $file = $2; if ( download( $_[0], $file ) ) { } } } sub download { if ( $nave->mirror( $_[0], $_[1] ) ) { if ( -f $_[1] ) { } } } sub toma { return $nave->get( $_[0] )->content; } #The End ?
Título: Re: [Perl] FindIcons 0.1
Publicado por: Eleкtro 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!
Título: Re: [Perl] FindIcons 0.1
Publicado por: BigBear en 26 Noviembre 2012, 00:05 am
ni idea solo la use para buscar los iconos del msn.
Título: Re: [Perl] FindIcons 0.1
Publicado por: Danyfirex en 26 Noviembre 2012, 00:39 am
Muy bonito código y muy útil. gracias
|