[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 You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login

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 ?