[Perl Tk] Codificator 0.2

Iniciado por BigBear, 7 Julio 2012, 16:06 PM

0 Miembros y 2 Visitantes están viendo este tema.

BigBear

Version Tk de este codificador.

Una imagen



El codigo

Código (perl) [Seleccionar]

#!usr/bin/perl
#Codificator 0.2
#Version Tk
#Coded By Doddy H

use Tk;
use Tk::Dialog;
use Digest::MD5;
use Digest::SHA1;
use MIME::Base64;
use URI::Escape;

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

$header = "This tool encode text in :

Hex
SHA1
MD5
Base64
ASCII
URL


";

my $color_fondo = "black", my $color_texto = "white";

$window = MainWindow->new( -background => "black", -foreground => "white" );
$window->geometry("380x370+80+80");
$window->title("Codificator 0.2 || Coded By Doddy H");
$window->resizable( 0, 0 );

$menula = $window->Frame(
    -relief     => "sunken",
    -bd         => 1,
    -background => $color_fondo,
    -foreground => $color_texto
);
my $menulnowaxm = $menula->Menubutton(
    -text             => "Options",
    -underline        => 1,
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -activebackground => $color_texto
)->pack( -side => "left" );
my $aboutnowaxm = $menula->Menubutton(
    -text             => "About",
    -underline        => 1,
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -activebackground => $color_texto
)->pack( -side => "left" );
my $exitnowaxm = $menula->Menubutton(
    -text             => "Exit",
    -underline        => 1,
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -activebackground => $color_texto
)->pack( -side => "left" );
$menula->pack( -side => "top", -fill => "x" );

$menulnowaxm->command(
    -label      => "Encode",
    -background => $color_fondo,
    -foreground => $color_texto,
    -command    => \&encode
);
$menulnowaxm->command(
    -label      => "Decode",
    -background => $color_fondo,
    -foreground => $color_texto,
    -command    => \&decode
);
$menulnowaxm->command(
    -label      => "Clean",
    -background => $color_fondo,
    -foreground => $color_texto,
    -command    => \&clear
);

$aboutnowaxm->command(
    -label      => "About",
    -background => $color_fondo,
    -foreground => $color_texto,
    -command    => \&about
);

$exitnowaxm->command(
    -label      => "Exit",
    -background => $color_fondo,
    -foreground => $color_texto,
    -command    => \&exitnow
);

$window->Label(
    -font       => "Impact",
    -background => $color_fondo,
    -foreground => $color_texto,
    -text       => "Options : "
)->place( -x => 110, -y => 53 );
$window->Optionmenu(
    -background       => $color_fondo,
    -foreground       => $color_texto,
    -activebackground => $color_texto,
    -options          => [
        [ HEX    => HEX ],
        [ ASCII  => ASCII ],
        [ BASE64 => BASE64 ],
        [ MD5    => MD5 ],
        [ SHA1   => SHA1 ],
        [ URL    => URL ]
    ],
    -variable     => \$var,
    -textvariable => \$codificacion
)->place( -x => 180, -y => 53 );

my $rot = $window->Text(
    -background => $color_fondo,
    -foreground => $color_texto,
    -width      => 45,
    -height     => 15
)->place( -x => 30, -y => 120 );
$rot->insert( 'end', $header );

MainLoop;

sub about {
    $window->Dialog(
        -title            => "About",
        -buttons          => ["OK"],
        -text             => "Coded By Doddy H",
        -background       => $color_fondo,
        -foreground       => $color_texto,
        -activebackground => $color_texto
    )->Show();
}

sub exitnow {
    exit 1;
}

sub clear {
    $rot->delete( '0.1', 'end' );
}

sub encode {
    $text = $rot->get( "1.0", "end" );
    chomp $text;
    &clear;
    if ( $codificacion eq "HEX" ) {
        $result = hexar($text);
        $rot->insert( 'end', $result );
        print $result;
    }

    elsif ( $codificacion eq "SHA1" ) {
        $sha1 = Digest::SHA1->new->add($text);
        my $digest = $sha1->digest;
        $rot->insert( 'end', $digest );
    }
    elsif ( $codificacion eq "BASE64" ) {
        $result = encode_base64($text);
        $rot->insert( 'end', $result );
    }
    elsif ( $codificacion eq "URL" ) {
        my $codec = Badger::Codec::URL->new();
        my $ya    = $codec->encode($text);
        $rot->insert( 'end', $ya );
    }
    elsif ( $codificacion eq "ASCII" ) {
        $result = ascii($text);
        $rot->insert( 'end', $result );
    }
    elsif ( $codificacion eq "MD5" ) {
        $digest = Digest::MD5->md5_hex($text);
        $rot->insert( 'end', $digest );
    }
    else {
        $window->messageBox( -message => "What?!\n" );
    }
}

sub decode {
    $text = $rot->get( "1.0", "end" );
    chomp $text;
    &clear;
    if ( $codificacion eq "HEX" ) {
        $result = decodera($text);
        $rot->insert( 'end', $result );
    }

    elsif ( $codificacion eq "SHA1" ) {
        $window->messageBox( -message =>
              "What?! , it's not possible with a function decoded\n" );
    }
    elsif ( $codificacion eq "BASE64" ) {
        $result = decode_base64($text);
        $rot->insert( 'end', $result );
    }
    elsif ( $codificacion eq "URL" ) {
        my $codec = Badger::Codec::URL->new();
        my $ya    = $codec->decode($text);
        $rot->insert( 'end', $ya );
    }
    elsif ( $codificacion eq "ASCII" ) {
        $result = ascii_de($text);
        $rot->insert( 'end', $result );
    }
    elsif ( $codificacion eq "MD5" ) {
        $window->messageBox( -message =>
              "What?! , it's not possible with a function decoded\n" );
    }
    else {
        $window->messageBox( -message => "What?!\n" );
    }
}

sub hexar {
    my $string = $_[0];
    $hex = '0x';
    for ( split //, $string ) {
        $hex .= sprintf "%x", ord;
    }
    return $hex;
}

sub ascii {
    return join ',', unpack "U*", $_[0];
}

sub decodera {
    $_[0] =~ s/^0x//;
    $encode = join q[], map { chr hex } $_[0] =~ /../g;
    return $encode;
}

sub ascii_de {
    $_[0] = join q[], map { chr } split q[,], $_[0];
    return $_[0];
}

# The End ?

0xDani

Un buen script como siempre. Una pregunta, tu siempre sacas versiones 0.x, pero ¿nunca trabajas mas a fondo en algo?

Saludos.
I keep searching for something that I never seem to find, but maybe I won't, because I left it all behind!

I code for $$$
Hago trabajos en C/C++
Contactar por PM

BigBear

si , considero personalmente que las versiones de 1.0 para arriba tienen que ser verdaderos programas y no simple scripts.

0xDani

¿Entonces no crees que se puede hacer un programa completo en un lenguaje interpretado?
I keep searching for something that I never seem to find, but maybe I won't, because I left it all behind!

I code for $$$
Hago trabajos en C/C++
Contactar por PM

BigBear

si se puede de hecho estoy haciendo uno ahora y la semana que viene publico otro que es 1.0



0xDani

¿Entonces te refieres a que el programa debe estar formado por mas de un script?
I keep searching for something that I never seem to find, but maybe I won't, because I left it all behind!

I code for $$$
Hago trabajos en C/C++
Contactar por PM

BigBear

no me referia a eso , me referia a que en la version 1.0 tendria que ser un programa decente , aunque esa es solo mi opinion personal.