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


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


Desconectado Desconectado

Mensajes: 545



Ver Perfil
[Perl] MP3 Downloader 0.1
« en: 27 Noviembre 2012, 15:53 pm »

Hice este simple script para buscar y bajar musica.

El codigo

Código
  1. #!usr/bin/perl
  2. #MP3 Downloader 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. my $se = "downloads_mp3";
  16.  
  17. unless ( -d $se ) {
  18.    mkdir( $se, "777" );
  19. }
  20.  
  21. chdir $se;
  22.  
  23. head();
  24.  
  25. print "[?] Song : ";
  26. chomp( my $song = <stdin> );
  27.  
  28. $song =~ s/ /-/;
  29.  
  30. print "\n[+] Searching ...\n\n";
  31.  
  32. my $code = toma( "http://mp3skull.com/mp3/" . $song . ".html" );
  33.  
  34. chomp $code;
  35.  
  36. if ( $code =~ /Sorry, no results found for/ ) {
  37.    print "\n[-] Not Found\n";
  38.    copyright();
  39. }
  40.  
  41. my @nombres;
  42. my @datas;
  43. my @links;
  44.  
  45. while ( $code =~ /<div style="font-size:15px;"><b>(.*)<\/b><\/div>/mig ) {
  46.    my $nombre = $1;
  47.  
  48.    #print "name : $nombre\n";
  49.    push( @nombres, $nombre );
  50. }
  51.  
  52. while ( $code =~ /<!-- info mp3 here -->\s+(.*?)<\/div>/migs ) {
  53.    my $data = $1;
  54.    $data =~ s/<br \/>/ /;
  55.    $data =~ s/<br \/>/ /;
  56.  
  57.    #print "data : $data\n";
  58.    push( @datas, $data );
  59. }
  60.  
  61. while ( $code =~ /<a href=\"(.*)\.mp3\"/mig ) {
  62.    my $link = $1 . ".mp3";
  63.  
  64.    #print "link : $link\n";
  65.    push( @links, $link );
  66. }
  67.  
  68. my $encontrados = int(@nombres) - 1;
  69.  
  70. for my $aca ( 0 .. $encontrados ) {
  71.    print "[Song $aca] : $nombres[$aca]\n";
  72.    print "[Data] : $datas[$aca]\n";
  73.    print "[Link] : $links[$aca]\n\n";
  74. }
  75.  
  76. print "\n[?] Number : ";
  77. chomp( my $number = <stdin> );
  78.  
  79. print "\n[+] Downloading ...\n";
  80.  
  81. now( $links[$number] );
  82.  
  83. print "\n[+] Finished\n";
  84.  
  85. copyright();
  86.  
  87. sub head {
  88.  
  89.    my @logo = (
  90.        "#=============================================#", "\n",
  91.        "#             MP3 Downloader 0.1              #", "\n",
  92.        "#---------------------------------------------#", "\n",
  93.        "# Written By Doddy H                          #", "\n",
  94.        "# Email: lepuke[at]hotmail[com]               #", "\n",
  95.        "# Website: doddyhackman.webcindario.com       #", "\n",
  96.        "#---------------------------------------------#", "\n",
  97.        "# The End ?                                   #", "\n",
  98.        "#=============================================#", "\n"
  99.    );
  100.  
  101.    print "\n";
  102.  
  103.    marquesina(@logo);
  104.  
  105.    print "\n\n";
  106.  
  107. }
  108.  
  109. sub copyright {
  110.  
  111.    my @fin = ("-- == (C) Doddy Hackman 2012 == --");
  112.  
  113.    print "\n\n";
  114.    marquesina(@fin);
  115.    print "\n\n";
  116.  
  117.    <stdin>;
  118.  
  119.    exit(1);
  120.  
  121. }
  122.  
  123. sub marquesina {
  124.  
  125.    #Effect based in the exploits by Jafer Al Zidjali
  126.  
  127.    my @logo = @_;
  128.  
  129.    my $car = "|";
  130.  
  131.    for my $uno (@logo) {
  132.        for my $dos ( split //, $uno ) {
  133.  
  134.            $|++;
  135.  
  136.            if ( $car eq "|" ) {
  137.                mostrar( "\b" . $dos . $car, "/" );
  138.            }
  139.            elsif ( $car eq "/" ) {
  140.                mostrar( "\b" . $dos . $car, "-" );
  141.            }
  142.            elsif ( $car eq "-" ) {
  143.                mostrar( "\b" . $dos . $car, "\\" );
  144.            }
  145.            else {
  146.                mostrar( "\b" . $dos . $car, "|" );
  147.            }
  148.            usleep(40_000);
  149.        }
  150.        print "\b ";
  151.    }
  152.  
  153.    sub mostrar {
  154.        print $_[0];
  155.        $car = $_[1];
  156.    }
  157.  
  158. }
  159.  
  160. sub now {
  161.  
  162.    my ( $scheme, $auth, $path, $query, $frag ) = uri_split( $_[0] );
  163.  
  164.    if ( $path =~ /(.*)\/(.*)$/ ) {
  165.        my $file = $2;
  166.        if ( download( $_[0], $file ) ) {
  167.        }
  168.    }
  169. }
  170.  
  171. sub download {
  172.    if ( $nave->mirror( $_[0], $_[1] ) ) {
  173.        if ( -f $_[1] ) {
  174.            return true;
  175.        }
  176.    }
  177. }
  178.  
  179. sub toma {
  180.    return $nave->get( $_[0] )->content;
  181. }
  182.  
  183. #The End ?
  184.  

Un ejemplo de uso

Código:

#=============================================#
#             MP3 Downloader 0.1              #
#---------------------------------------------#
# Written By Doddy H                          #
# Email: lepuke[at]hotmail[com]               #
# Website: doddyhackman.webcindario.com       #
#---------------------------------------------#
# The End ?                                   #
#=============================================#


[?] Song : bones now

[+] Searching ...

[Song 0] : Discovery Now - bionic bones mp3
[Data] : 256 kbps 1:30 2.79 mb
[Link] : http://www.whro.org/home/html/podcasts/discoverynow/041408.mp3

[Song 1] : Sean Bones - 'Here Now' mp3
[Data] : 128 kbps 3:28 3.19 mb
[Link] : http://serve.castfire.com/audio/878039/sean-bones-here-now_2012-02-23-1
74939.128.mp3

[Song 2] : Discovery Now - bionic bones mp3
[Data] : 256 kbps  00:01:30 2.8 mb
[Link] : http://whro.org/home/html/podcasts/discoverynow/041408.mp3

[Song 3] : Sean Bones - Here Now mp3
[Data] : 5.02 mb
[Link] : http://www.hulkshare.com/dl/4t42l4kxi811/sean_bones_-_here_now.mp3

[Song 4] : Fuego Ft. Amara - Lo Que Quiero (Prod. By Bones, Now & Laterz) (Www.S
tiloCaro.Com) mp3
[Data] : 4.43 mb
[Link] : http://www.hulkshare.com/dl/w86wxq8bl0n4/fuego_ft._amara_-_lo_que_quier
o_%28prod._by_bones%2c_now_%26_laterz%29.mp3

[Song 5] : Sean Bones - Here Now mp3
[Data] : 160 kbps 3:27 3.95 mb
[Link] : http://myspoonful.com/wp-content/uploads/Sean-Bones-Here-Now.mp3

[Song 6] : Frankie Bones - Bonesbreaks Vol. 2 (B2) On The Beat Now-freestyle na
veia mp3
[Data] : 4:40 mins 6.41 mb
[Link] : http://dc203.4shared.com/img/564370108/97ff8470/dlink__2Fdownload_2FS4X
eLchH_3Ftsid_3D20121127-94941-8934f180/preview.mp3


[?] Number : 1

[+] Downloading ...

[+] Finished


-- == (C) Doddy Hackman 2012 == --



En línea

Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.878



Ver Perfil
Re: [Perl] MP3 Downloader 0.1
« Respuesta #1 en: 27 Noviembre 2012, 16:01 pm »

jajaja, me robaste la idea sin saberlo!
Iba a hacerlo exactamente en el mismo buscador xD, mp3skull, que buen buscador gratis!

Gracias por el code!

Un saludo Doddy.


En línea



BigBear


Desconectado Desconectado

Mensajes: 545



Ver Perfil
Re: [Perl] MP3 Downloader 0.1
« Respuesta #2 en: 27 Noviembre 2012, 16:18 pm »

na , el mejor es beemp3 pero usa captcha para darte el link.
En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Downloader!!!!
Programación Visual Basic
digitalice 3 2,020 Último mensaje 14 Marzo 2006, 15:25 pm
por Kizar
Libros de Perl online [PERL]
Scripting
madpitbull_99 0 4,022 Último mensaje 18 Mayo 2011, 21:49 pm
por madpitbull_99
[Perl] Simple Downloader 0.1
Scripting
BigBear 0 1,665 Último mensaje 6 Mayo 2012, 02:08 am
por BigBear
[Perl Tk] Simple Downloader 0.1
Scripting
BigBear 0 1,832 Último mensaje 6 Mayo 2012, 02:08 am
por BigBear
[Perl] PasteBin Downloader 0.1
Scripting
BigBear 0 1,886 Último mensaje 20 Julio 2013, 23:58 pm
por BigBear
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines