[Perl Tk] Lix.In Decoder 0.2

Iniciado por BigBear, Marzo 28, 2012, 05:58:35 PM

Tema anterior - Siguiente tema

0 Miembros y 1 Visitante están viendo este tema.

Marzo 28, 2012, 05:58:35 PM Ultima modificación: Marzo 14, 2015, 10:17:08 AM por Expermicid
Hola a todos.

Aca les traigo la version Tk de un script que habia hecho para decodificar las url No tienes permitido ver los links. Registrarse o Entrar a mi cuenta

Lo bueno del programa es que guarda todo los logs en la carpeta donde ejecutaron el programa

Una imagen del programa seria


Código: perl

#!usr/bin/perl
#Lix.In Decoder 0.2
#Version Tk
#Coded By Doddy H

use LWP::UserAgent;
use URI::Split qw(uri_split);
use Tk;
use Tk::Dialog;

#if ( $^O eq 'MSWin32' ) {
#    use Win32::Console;
#    Win32::Console::Free();
#}

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);

my $color_fondo = "black";
my $color_text  = "green";

my $ben =
  MainWindow->new( -background => $color_fondo, -foreground => $color_text );

$ben->title("Lix.In Decoder 0.2 (C) Doddy Hackman 2012");
$ben->geometry("492x385+20+20");
$ben->resizable( 0, 0 );

$ben->Label(
    -background => $color_fondo,
    -foreground => $color_text,
    -text       => "Page : ",
    -font       => "Impact1"
)->place( -x => 20, -y => 20 );
my $page = $ben->Entry(
    -background => $color_fondo,
    -foreground => $color_text,
    -width      => 40
)->place( -x => 73, -y => 24 );

$ben->Button(
    -text             => "Decode",
    -width            => 10,
    -command          => \&home,
    -background       => $color_fondo,
    -foreground       => $color_text,
    -activebackground => $color_text
)->place( -x => 325, -y => 23 );
$ben->Button(
    -text             => "Logs",
    -width            => 10,
    -command          => \&logs,
    -background       => $color_fondo,
    -foreground       => $color_text,
    -activebackground => $color_text
)->place( -x => 400, -y => 23 );

$ben->Label(
    -text       => "Links Found",
    -font       => "Impact",
    -background => $color_fondo,
    -foreground => $color_text
)->place( -x => 200, -y => 80 );
my $links = $ben->Listbox(
    -width      => 70,
    -height     => 15,
    -background => $color_fondo,
    -foreground => $color_text
)->place( -x => 32, -y => 140 );

MainLoop;

sub home {

    $links->delete( "0.0", "end" );

    my $url = $page->get;

    my $code = toma($url);

    while ( $code =~ m{http://lix\.in/(-\w+)}ig ) {
        push( @urls, "http://lix.in/" . $1 );
    }

    while ( $code =~ m{http://lix\.in/(\w+)}ig ) {
        push( @urls, "http://lix.in/-" . $1 );
    }

    my @urls = repes(@urls);

    for my $l (@urls) {
        chomp $l;
        $ben->update;
        decode_link( $l, $url );
    }
}

sub decode_link {

    my ( $link, $url ) = @_;

    my ( $scheme, $auth, $path, $query, $frag ) = uri_split($url);

    if ( $link =~ /-(.*)/ ) {
        my $co = "-" . $1;
        chomp $co;
        my $code =
          tomar( $link,
            { "tiny" => $co, "submit" => "continue", "submit" => "submit" } );
        if ( $code =~ /<iframe  name="ifram" src="(.*)" marginwidth="0"/ ) {
            my $link = $1;
            chomp $link;
            unless ( $link =~ /lix\.in/ ) {
                savefile( $auth . ".txt", $link );
                $links->insert( "end", $link );
            }
        }
    }
}

sub logs {

    my ( $scheme, $auth, $path, $query, $frag ) = uri_split( $page->get );
    my $f = $auth . ".txt";

    if ( -f $f ) {
        system($f);
    }
    else {
        $ben->Dialog(
            -title            => "Error",
            -buttons          => ["OK"],
            -text             => "Logs not found",
            -background       => $color_fondo,
            -foreground       => $color_text,
            -activebackground => $color_text
        )->Show();
    }
}

sub repes {
    my @limpio;
    foreach $test (@_) {
        push @limpio, $test unless $repe{$test}++;
    }
    return @limpio;
}

sub savefile {
    open( SAVE, ">>" . $_[0] );
    print SAVE $_[1] . "\n";
    close SAVE;
}

sub toma {
    return $nave->get( $_[0] )->content;
}

sub tomar {
    my ( $web, $var ) = @_;
    return $nave->post( $web, [ %{$var} ] )->content;
}

# The End ?