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

 

 


Tema destacado: Curso de javascript por TickTack


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


Desconectado Desconectado

Mensajes: 545



Ver Perfil
[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.  


En línea

Eleкtro
Ex-Staff
*
Desconectado Desconectado

Mensajes: 9.822



Ver Perfil
Re: [Perl Tk] Gmail Inbox 0.1
« Respuesta #1 en: 29 Abril 2012, 05:04 am »

No habia visto este programa, Muy bueno!!

saludos


En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Gmail actualiza su Priority Inbox
Noticias
wolfbcn 0 1,679 Último mensaje 8 Diciembre 2010, 22:47 pm
por wolfbcn
[Perl] Gmail Inbox 0.1
Scripting
BigBear 0 1,543 Último mensaje 28 Abril 2012, 16:50 pm
por BigBear
Google te invita a olvidarte de Gmail con una redirección si usas Inbox
Noticias
wolfbcn 0 926 Último mensaje 2 Diciembre 2015, 21:46 pm
por wolfbcn
Cómo forzar que Gmail abra Inbox, y por qué deberías hacerlo
Noticias
wolfbcn 0 1,010 Último mensaje 16 Marzo 2017, 22:40 pm
por wolfbcn
Focused Inbox llegará a Gmail en la app de Outlook para Windows 10
Noticias
wolfbcn 1 1,306 Último mensaje 30 Abril 2017, 03:45 am
por reygun30012
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines