Welcome to HBH! If you had an account on hellboundhacker.org you will need to reset your password using the Lost Password system before you will be able to login.

Bincode coder/decoder - Perl Code Bank


Bincode coder/decoder
Encode value to bincode Decode bincode to value
                #!/usr/bin/perl

# Coded by Trizen under the GPL.
# Email: echo dHJpemVueEBnbWFpbC5jb20K | base64 -d
# Website: http://trizen.go.ro

use bigint;
use warnings;
use strict 'refs';

my @argv_nrs;
my @encoded_array;

my $opt_arg  = 0;
my $verbose  = 0;
my $decoding = 0;

foreach $_ (@ARGV) {
    if ( $_ =~ /^\d+$/ ) {
        push @argv_nrs, $_;
    }
    else {
        $opt_arg = 1;
    }
}
foreach $_ (@ARGV) {
    if (/^-+(?:h|help)$/) {
        print "
Usage: $0 [option] [value|binar]
\nOptions:
 -e, --encode
 -d, --decode
 -v, --verbose
\nExamples:
 $0 121
 $0 1111001 -d
\n";
        exit;
    }
    if (/^-+(?:v|verbose)$/) {
        $verbose = 1;
    }
    if (/^-+(?:d|decode)$/) {
        $decoding = 1;
    }
}
&_encode unless $decoding;
&_decode if $decoding;

sub _decode {
    use warnings;
    use strict 'refs';
    if ( $#argv_nrs < 0 ) {
        print "=>> Decode a value:\n> ";
        foreach $_ ( split( /\D/, <STDIN>, 0 ) ) {
            print decode($_) . "\n";
        }
    }
    else {
        foreach $_ (@argv_nrs) {
            print decode($_) . "\n";
        }
    }
}

sub _encode {
    use warnings;
    use strict 'refs';
    if ( $#argv_nrs < 0 ) {
        print "=>> Encode a value:\n> ";
        foreach $_ ( split( /\D/, <STDIN>, 0 ) ) {
            print encode($_) . "\n";
        }
    }
    else {
        foreach $_ (@argv_nrs) {
            print encode($_) . "\n";
        }
    }
}

sub decode {
    use warnings;
    use strict 'refs';
    my $code   = shift @_;
    my $length = length $code;
    print "\nDecoding: $code\nLength: "
      . $length . '-1 = '
      . ( $length - 1 ) . "\n\n"
      if $verbose;
    my (@binars) = split( //, $code, 0 );
    my ( @codes, $nr, $number, $binar_code );
    foreach $_ (@binars) {
        ++$length;
        if ($number) {
            $nr = $number - 1;
        }
        else {
            $nr = $length - 2;
        }
        $number = $nr;
        $binar_code += $_ * 2**$nr;
        print "$_ * 2^$nr = $binar_code\n" if $verbose;
    }
    print "\n" if $verbose;
    return $binar_code;
}

sub encode {
    use warnings;
    use strict 'refs';
    $#encoded_array = -1 unless $#_ == 1;
    my $nr = shift @_;
    return $nr if $nr =~ /^(?:0|1|)$/;
    my $nr1 = int $nr / 2;
    print "\n$nr\t= $nr1" if $verbose;
    my $nr2 = $nr1 * 2;
    my $nr3 = $nr - $nr2;
    print "\t * 2 \t+ $nr3" if $verbose;
    push @encoded_array, $nr3;

    if ( $nr1 != 1 ) {
        &encode( $nr1, 're-encode' );
    }
    my $bin = join( '', @encoded_array );
    $bin = 1 . reverse($bin);
    print "\n1\t= 0\t * 2 \t+ 1\n" if $verbose;
    return $bin;
}

            
Comments
Sorry but there are no comments to display