OS:Windows 2000 Professional
Perl:ActivePerl 5.8
C compiler:MS Visual C++ 6.0
Location:C:\pgg\
download:http://www.chinaperl.org/perlfans/pgg/download/p_cc.ple
equal:perl -e encode

[download]
c:\pGG\bin>type oldcc.pl
use MD5;
my $md=new MD5;
my $gh=MD5->hexhash("p_cc");
print $gh;
c:\pGG\bin>oldcc.pl
03742820f50fb5d9d5ab876d0231eb20
c:\pGG\bin>perlcc oldcc.pl
###Error!!!
____________________________________________________________________
###Now,try p_cc.pl.
c:\pGG\bin>p_cc.pl

c:\pGG\bin>type newcc.pl
eval eval '"'.


('['^'.').('['^'(').('`'|'%').('{'^'[').('`'^'-').('`'^'$').('^'^('`'|
+'+')).';'.
('!'^'+').('`'|'-').('['^'"').('{'^'[').'\\'.'$'.('`'|'-').('`'|'$').'
+='.('`'|'.
').('`'|'%').('['^',').('{'^'[').('`'^'-').('`'^'$').('^'^('`'|'+')).'
+;'.('!'^'+
').('`'|'-').('['^'"').('{'^'[').'\\'.'$'.('`'|"'").('`'|'(').'='.('`'
+^'-').('`'
^'$').('^'^('`'|'+')).'-'.'>'.('`'|'(').('`'|'%').('['^'#').('`'|'(').
+('`'|'!').
('['^'(').('`'|'(').'('.'\\'.'"'.('['^'+').'_'.('`'|'#').('`'|'#').'\\
+'.'"'.')'.
';'.('!'^'+').('['^'+').('['^')').('`'|')').('`'|'.').('['^'/').('{'^'
+[').'\\'.'
$'.('`'|"'").('`'|'(').';'.'"'
c:\pGG\bin>perlcc newcc.pl
pcccj8V3.c
pcccj8V3.c(346) : warning C4101: 'targ' : unreferenced local variable
pcccj8V3.c(1462) : warning C4101: 'targ' : unreferenced local variable

c:\pGG\bin>a.exe
03742820f50fb5d9d5ab876d0231eb20
c:\pGG\bin>
####################################################################
#                             p_cc.pl                           #
####################################################################
#!c:/pgg/bin/perl.exe -w
use strict;
#####  Name:      p_cc.pl
#####  Version:   0.0.1.0
#####  Author:    pGG
#####  Contact:   y6cme@sohu.com
#####  Licence:   The license of Perl
#####  Updated:   2003-2-3
my $one=shift||'oldcc.pl';
my $two=shift||'newcc.pl';
my @C=(
q Z('!'^'!')Z,q Z('('^')')Z,q Z('<'^'>')Z,q Z('>'^'=')Z,
q Z('>'^':')Z,q Z('>'^';')Z,q Z('+'^'-')Z,q Z('*'^'-')Z,
q Z('+'^'#')Z,q Z('*'^'#')Z,q Z('!'^'+')Z,q Z('!'^'*')Z,
q Z('!'^'-')Z,q Z('!'^',')Z,q Z('!'^'/')Z,q Z('!'^'.')Z,
q Z('?'^'/')Z,q Z('<'^'-')Z,q Z('-'^'?')Z,q Z('.'^'=')Z,
q Z('+'^'?')Z,q Z('*'^'?')Z,q Z('?'^')')Z,q Z('<'^'+')Z,
q Z('%'^'=')Z,q Z('&'^'?')Z,q Z('?'^'%')Z,q Z('>'^'%')Z,
q Z('&'^':')Z,q Z('<'^'!')Z,q Z('?'^'!')Z,q Z('%'^':')Z,
q Z('{'^'[')Z,q Z'!'Z,q Z'\\\\'.'"'Z,q Z'#'Z,
q Z'\\\\'.'$'Z,q Z'%'Z,q Z'&'Z,q Z"'"Z,q Z'('Z,q Z')'Z,
q Z'*'Z,q Z'+'Z,q Z','Z,q Z'-'Z,q Z'.'Z,q Z'/'Z,
q Z('^'^('`'|'.'))Z,q Z('^'^('`'|'/'))Z,q Z('^'^('`'|','))Z,
q Z('^'^('`'|'-'))Z,q Z('^'^('`'|'*'))Z,q Z('^'^('`'|'+'))Z,
q Z('^'^('`'|'('))Z,q Z('^'^('`'|')'))Z,q Z(':'&'=')Z,
q Z(';'&'=')Z,q Z':'Z,q Z';'Z,q Z'<'Z,q Z'='Z,q Z'>'Z,q Z'?'Z,
q Z'\\\\'.'@'Z,q Z('`'^'!')Z,q Z('`'^'"')Z,q Z('`'^'#')Z,
q Z('`'^'$')Z,q Z('`'^'%')Z,q Z('`'^'&')Z,q Z('`'^"'")Z,
q Z('`'^'(')Z,q Z('`'^')')Z,q Z('`'^'*')Z,q Z('`'^'+')Z,
q Z('`'^',')Z,q Z('`'^'-')Z,q Z('`'^'.')Z,q Z('`'^'/')Z,
q Z('{'^'+')Z,q Z('{'^'*')Z,q Z('{'^')')Z,q Z('{'^'(')Z,
q Z('{'^'/')Z,q Z('{'^'.')Z,q Z('{'^'-')Z,q Z('{'^',')Z,
q Z('{'^'#')Z,q Z('{'^'"')Z,q Z('{'^'!')Z,q Z'['Z,
q Z'\\\\'.'\\\\'Z,q Z']'Z,q Z'^'Z,q Z'_'Z,
q Z'`'Z,q Z('`'|'!')Z,q Z('`'|'"')Z,q Z('`'|'#')Z,
q Z('`'|'$')Z,q Z('`'|'%')Z,q Z('`'|'&')Z,q Z('`'|"'")Z,
q Z('`'|'(')Z,q Z('`'|')')Z,q Z('`'|'*')Z,q Z('`'|'+')Z,
q Z('`'|',')Z,q Z('`'|'-')Z,q Z('`'|'.')Z,q Z('`'|'/')Z,
q Z('['^'+')Z,q Z('['^'*')Z,q Z('['^')')Z,q Z('['^'(')Z,
q Z('['^'/')Z,q Z('['^'.')Z,q Z('['^'-')Z,q Z('['^',')Z,
q Z('['^'#')Z,q Z('['^'"')Z,q Z('['^'!')Z,q Z'\\\\'.'{'Z,
q Z'|'Z,q Z'\\\\'.'}'Z,q Z'~'Z,q Z('!'^'^')Z
);
push @C,map{join '.',q#'\\\\'#,$C[120],map($C[$_],unpack('C*',sprintf(
+'%x',$_)))}128..255;
my @D=map{chr()}0..255;
my $gh="eval eval \'\"\'\.";
my $mm="\'\"\'";
my @cd;
for(0..255){
push(@cd,$D[$_],$C[$_]);
}
my %CD=@cd;
open(OLD,"$one") or die "$!";
open(NEW,">$two") or die "$!";
my @array;
while(<OLD>){
push(@array,$_);
}
my $vov=join("",@array);
my $len=length($vov);
print NEW "$gh\n\n\n";
for(0..$len-1){
my $str=substr($vov,$_,1);
print NEW "$CD{$str}\.";
}
print NEW $mm;
close OLD;
close NEW;
#enjoy it

[download]

Replies are listed 'Best First'.
Re: p_cc.pl
by pGG (Initiate) on Feb 08, 2003 at 11:53 UTC 
    Hi,all,have some nice advise on p_cc.pl for me,please?thank you!
good luck!

    [download]
[reply]
[d/l]
    cc2p.pl
    by pGG (Initiate) on Feb 08, 2003 at 12:32 UTC 
      #!c:/pgg/bin/perl.exe -w
use strict;
#####  Name:      cc2p.pl
#####  Version:   0.0.1.0
#####  Author:    pGG
#####  Contact:   y6cme@sohu.com  [http://perl.3322.org/~pgg]
#####  Licence:   The license of Perl
#####  Updated:   2003-2-8
my $old=shift||'cc2p.exe';
my $new=shift||'cc2p.ple';
open(FILE,$old);
binmode(FILE);
my $gh;
while(<FILE>){
$gh.=$_;
}
my $hmm=index($gh,'-e',0);
my $vov=index($gh,'dl_win32.c',0);
$hmm+=2;
$vov-=1;
my $len=$vov-$hmm;
close FILE;
open(OLD,$old);
binmode(OLD);
my $pgg;
seek(OLD,$hmm,1);
read(OLD,$pgg,$len,0);
$pgg=~s/\\\$/\$/g;
$pgg=~s/\\\{/\{/g;
$pgg=~s/\\\}/\}/g;
$pgg=~s/\\\\/\\/g;
$pgg=~s/\\\"/\"/g;
$pgg=~s/\\\@/\@/g;
open(NEW,">$new");
print NEW $pgg;
close OLD;
close NEW;
#enjoy

      [download]
[reply]
[d/l]
        #!c:/pgg/bin/perl.exe -w
use strict;
#####  Name:      p_cc.pl
#####  Version:   0.0.2.0
#####  Author:    pGG
#####  Contact:   y6cme@sohu.com
#####  Licence:   The license of Perl
#####  Updated:   2003-2-9
my @op=@ARGV;
if(@op < 1){
die "Error!Please enter option!";
}
my $wha=pop(@op);
rename($wha,'y6cmE.pl');
my @C=(
q Z('!'^'!')Z,q Z('('^')')Z,q Z('<'^'>')Z,q Z('>'^'=')Z,
q Z('>'^':')Z,q Z('>'^';')Z,q Z('+'^'-')Z,q Z('*'^'-')Z,
q Z('+'^'#')Z,q Z('*'^'#')Z,q Z('!'^'+')Z,q Z('!'^'*')Z,
q Z('!'^'-')Z,q Z('!'^',')Z,q Z('!'^'/')Z,q Z('!'^'.')Z,
q Z('?'^'/')Z,q Z('<'^'-')Z,q Z('-'^'?')Z,q Z('.'^'=')Z,
q Z('+'^'?')Z,q Z('*'^'?')Z,q Z('?'^')')Z,q Z('<'^'+')Z,
q Z('%'^'=')Z,q Z('&'^'?')Z,q Z('?'^'%')Z,q Z('>'^'%')Z,
q Z('&'^':')Z,q Z('<'^'!')Z,q Z('?'^'!')Z,q Z('%'^':')Z,
q Z('{'^'[')Z,q Z'!'Z,q Z'\\\\'.'"'Z,q Z'#'Z,
q Z'\\\\'.'$'Z,q Z'%'Z,q Z'&'Z,q Z"'"Z,q Z'('Z,q Z')'Z,
q Z'*'Z,q Z'+'Z,q Z','Z,q Z'-'Z,q Z'.'Z,q Z'/'Z,
q Z('^'^('`'|'.'))Z,q Z('^'^('`'|'/'))Z,q Z('^'^('`'|','))Z,
q Z('^'^('`'|'-'))Z,q Z('^'^('`'|'*'))Z,q Z('^'^('`'|'+'))Z,
q Z('^'^('`'|'('))Z,q Z('^'^('`'|')'))Z,q Z(':'&'=')Z,
q Z(';'&'=')Z,q Z':'Z,q Z';'Z,q Z'<'Z,q Z'='Z,q Z'>'Z,q Z'?'Z,
q Z'\\\\'.'@'Z,q Z('`'^'!')Z,q Z('`'^'"')Z,q Z('`'^'#')Z,
q Z('`'^'$')Z,q Z('`'^'%')Z,q Z('`'^'&')Z,q Z('`'^"'")Z,
q Z('`'^'(')Z,q Z('`'^')')Z,q Z('`'^'*')Z,q Z('`'^'+')Z,
q Z('`'^',')Z,q Z('`'^'-')Z,q Z('`'^'.')Z,q Z('`'^'/')Z,
q Z('{'^'+')Z,q Z('{'^'*')Z,q Z('{'^')')Z,q Z('{'^'(')Z,
q Z('{'^'/')Z,q Z('{'^'.')Z,q Z('{'^'-')Z,q Z('{'^',')Z,
q Z('{'^'#')Z,q Z('{'^'"')Z,q Z('{'^'!')Z,q Z'['Z,
q Z'\\\\'.'\\\\'Z,q Z']'Z,q Z'^'Z,q Z'_'Z,
q Z'`'Z,q Z('`'|'!')Z,q Z('`'|'"')Z,q Z('`'|'#')Z,
q Z('`'|'$')Z,q Z('`'|'%')Z,q Z('`'|'&')Z,q Z('`'|"'")Z,
q Z('`'|'(')Z,q Z('`'|')')Z,q Z('`'|'*')Z,q Z('`'|'+')Z,
q Z('`'|',')Z,q Z('`'|'-')Z,q Z('`'|'.')Z,q Z('`'|'/')Z,
q Z('['^'+')Z,q Z('['^'*')Z,q Z('['^')')Z,q Z('['^'(')Z,
q Z('['^'/')Z,q Z('['^'.')Z,q Z('['^'-')Z,q Z('['^',')Z,
q Z('['^'#')Z,q Z('['^'"')Z,q Z('['^'!')Z,q Z'\\\\'.'{'Z,
q Z'|'Z,q Z'\\\\'.'}'Z,q Z'~'Z,q Z('!'^'^')Z
);
push @C,map{join '.',q#'\\\\'#,$C[120],map($C[$_],unpack('C*',sprintf(
+'%x',$_)))}128..255;
my @D=map{chr()}0..255;
my $gh="eval eval \'\"\'\.";
my $mm="\'\"\'";
my @cd;
for(0..255){
push(@cd,$D[$_],$C[$_]);
}
my %CD=@cd;
open(OLD,'y6cmE.pl') or die "$!";
open(NEW,">$wha") or die "$!";
my @array;
while(<OLD>){
push(@array,$_);
}
my $vov=join("",@array);
my $len=length($vov);
print NEW "$gh\n\n\n";
for(0..$len-1){
my $str=substr($vov,$_,1);
print NEW "$CD{$str}\.";
}
print NEW $mm;
close OLD;
close NEW;
push(@op,$wha);
system "perlcc.bat @op";
unlink($wha);
rename('y6cmE.pl',$wha);
#enjoy it

        [download]
[reply]
[d/l]

Back to Cool Uses for Perl