#!/usr/bin/perl -w
use 5.004;$|=1;my$c=$0;my$d="Z:\\Test.pl";my$e=1;my$f=0;print"\n\nZsolt's Perl Compressor & Obfuscator v1 FREEWARE";my$g=-s $c;print"\nReading file: $c  ($g bytes)";my$h=ReadTheEntireFile($c); $h=~tr|\r\n\t\x20-\x7E||cd;my$i=$g-length($h);print"\nBinary characters removed: $i";$h=~s/\r\n/\n/g; $h=~tr|\r|\n|;my$j=$h=~tr|\n|\n|;print"\nNumber of lines: ",($j+1);my$k=' a b _ 0 1 2 3 4 5 6 7 8 9 ENV ARG ARGV ARGVOUT PID GID EGID UID EUID SUBSEP F INC ISA OSNAME SIG BASETIME MATCH PREMATCH POSTMATCH OFS NR RS ORS WARNING ERRNO PERLDB LIST_SEPARATOR PROCESS_ID PROGRAM_NAME REAL_GROUP_ID EFFECTIVE_GROUP_ID REAL_USER_ID EFFECTIVE_USER_ID SUBSCRIPT_SEPARATOR OLD_PERL_VERSION SYSTEM_FD_MAX INPLACE_EDIT PERL_VERSION EXECUTABLE_NAME LAST_PAREN_MATCH LAST_SUBMATCH_RESULT LAST_MATCH_END LAST_PAREN_MATCH LAST_MATCH_START LAST_REGEXP_CODE_RESULT OUTPUT_FIELD_SEPARATOR INPUT_LINE_NUMBER INPUT_RECORD_SEPARATOR OUTPUT_RECORD_SEPARATOR OUTPUT_AUTOFLUSH ACCUMULATOR FORMAT_FORMFEED FORMAT_PAGE_NUMBER FORMAT_LINES_LEFT FORMAT_LINE_BREAK_CHARACTERS FORMAT_LINES_PER_PAGE FORMAT_TOP_NAME FORMAT_NAME EXTENDED_OS_ERROR EXCEPTIONS_BEING_CAUGHT OS_ERROR EVAL_ERROR COMPILING DEBUGGING VERSION ';my@l;my$m=2000;if($e){@l=GenerateShortVariableNames($m);}print"\nProcessing code...";my@n; my$o='';my$p=0;my$q; my$r='';my$s='';my$t='';my$u=0;my$v=0;my%w; my$x=0;for(;$x< length($h);$x++){$q=$o;$o=substr($h,$x,1);$p=vec($h,$x,8);if($p==32||$p==9||$p==10){$v=1;next;}if($p==123){$t='BLOCK';push(@n,'{');$u++;next;}if($p==125){$t='BLOCK';push(@n,'}');if($u>0){$u--;}else{print"\nWarning: Missing opening brace.\n";}if($f&& $u==0){push(@n,"\n");}next;}if($p==60){if($s eq'='||($t ne'VAR'&&$t ne'NUM')){my$y=substr($h,$x,32);if($y=~m/\<\<\s*['"]{,1}|\<\<[a-zA-Z\_]+/){CaptureHeredoc() and next;}}}if($o eq'='&&$q eq"\n"){CapturePOD() and next;}if($p==47&&($t eq'WORD'&&index('])}',$s)<0)||($o eq'~'&&index('=!',$q)>=0)){CaptureRegex() and next;}if($p==36||$p==64||$p==37){if(index('*+-[{(;,=',$s)<0){if($v&&($t eq'VAR'&&$p==36)||($t eq'WORD'&&index(' my our defined undef return '," $r ")<0)){push(@n,' ');}}CaptureVariable() and next;}if($o eq'#'&&$q ne'$'){CaptureComment();next;}my$z=index('[]()<>;,!?=$@%&:+*^|\\\/~-.',$o);if($z>=0){if($v&& $o eq'.'&&$t eq'NUM'){push(@n,' ');}push(@n,$o);$s=$o;$v=0;next;}if($p>47&&$p<58){if(index('<>,:;|[(%/*=+-',$s)<0){if($v&&((index('.',$s)>=0)||($t eq'WORD'||$t eq'VAR'))){push(@n,' ');}}CaptureNumber();next;}if($p==34||$p==39||$p==96){if(index('={}[]();,.',$s)<0){if($v&& $s eq'$'||$t eq'STR'||$t eq'VAR'){push(@n,' ');}}CaptureString();next;}if($p==95||($p>96&&$p<123)||($p>64&&$p<91)){if(index('*+-[{(;,=',$s)<0){if($v&&($t eq'WORD'||$t eq'VAR'||$t eq'SYM')){push(@n,' ');}}$v=1;$s='x';my$A=CaptureWord();if($p==113&&index(' qq qw qx qr q '," $A ")>=0){$r=$A;CaptureQQ();next;}if($r eq'sub'){print'.';}if($A eq'__END__'){pop(@n);last;}if($A eq'__DATA__'){$x++;CaptureTail();last;}$r=$A;next;}}undef%w; undef$h;undef@l; print"\nSaving file: $d  ";CreateFile($d,@n);$g=-s $d;print"($g bytes)\n\n";exit; sub CaptureRegex{my$B=$x;my$C='';my$D='';my$y=substr($h,$x,256);my$E=0;if($y=~m/^(\~\s*tr\s*)([^\t\n ]{1})/){$D='~tr';$E=length($1);$C=$2 x 2;}elsif($y=~m/^(\~\s*y\s*)([^\t\n ]{1})/){$D='~y';$E=length($1);$C=$2 x 2;}elsif($y=~m/^(\~\s*s\s*)([^\t\n ]{1})/){$D='~s';$E=length($1);$C=$2 x 2;}elsif($y=~m/^(\~\s*m\s*)([^\t\n ]{1})/){$D='~m';$E=length($1);$C=$2;}elsif($y=~m/^(\~?)(\s*)\//){$D=$1;$E=length($D. $2);$C='/';}else{$x=$B;return 0;}length($D) and push(@n,$D);$x+=$E; $C=GetSeparatorCharacters($C);CapturePattern($C);$t='REGEX';$r='';$s='x';$v=0;return 1;}sub CaptureQQ{my$G=substr($h,++$x,1);my$C=GetSeparatorCharacters($G);CapturePattern($C);$t='REGEX';$r='';$s='x';$v=0;return 1;}sub CapturePattern{my$C=shift;my$G=substr($C,0,1);my$H=substr($C,1,1);my$I=(length($C)==2)?1:2;my$J=$G eq $H;if($J){$I++;$C=$G;}my$K=0;my$L=0;my$B=$x;my$M='';for(;$x< length($h);$x++){my$o=substr($h,$x,1);$M.=$o; if(($o eq'\\'&&($K& 1)==0)||$o eq'$'||$o eq'@'){my$y=substr($h,$x,500);if($y=~m/^([\$\@]{1}[a-zA-Z\_]{1}[a-zA-Z\_0-9]*)/){my$N=$1;$x+=length($N)-1;$M.=ReplaceVariable($N);}elsif($y=~m/^(Q\s*)([\$\@]{1}[a-zA-Z0-9\_]+)(\s*\\E)/){my$O=$1;my$N=$2;my$P=$3;$x+=length($O)+length($N)+length($P)-1;$M.=ReplaceVariable($N)."\\E";}}if(($K& 1)==0){if($J){if($o eq $C){$I--;}}else{if($o eq $G){$L++;}if($o eq $H){$L--;if($L==0){$I--;}}}if($I==0){last;}}if($o eq'\\'){$K++;}else{$K=0;}}if($x+1==length($h)){print"\nError: Unexpected end of file in the middle of regex or quoted list.\n";return 0;}push(@n,$M);return 1;}sub GetSeparatorCharacters{my$C=defined$_[0]?$_[0]:'';length($C) or return'';my$G=substr($C,0,1);my$H=$G;if($G eq'('){$H=')';}if($G eq'['){$H=']';}if($G eq'<'){$H='>';}if($G eq'{'){$H='}';}if($G eq $H){return(length($C)==1)?$G x 2:$G x 3;}my$Q=$G. $H;return(length($C)==1)?$Q: $Q x 2;}sub CapturePOD{my$y=substr($h,$x,64);if($y=~m/^(\=[a-zA-Z]+)/){$x+=length($1);$x=index($h,"\n=cut",$x);if($x>0){$x+=4;}else{$x=length($h);}$s='x';$r='';$v=1;return 1;}else{return 0;}}sub CaptureNumber{my$y=substr($h,$x,512);my$R='';if($y=~m/([0-9]+)/){$R=$1;}elsif($y=~m/(0x[0-9a-fA-F]+)/){$R=$1;}elsif($y=~m/(0b[01]+)/){$R=$1;}elsif($y=~m/([0-9\_]*[0-9]{3})/){$R=$1;}elsif($y=~m/([0-9]+\.[0-9]+)/){$R=$1;}elsif($y=~m/([0-9]+[0-9.]*[eE]{1}[\-\+]{,1}[0-9]+)/){$R=$1;}elsif($y=~m/([0-9.]+)/){$R=$1;}if(length($R)){$x+=length($R)-1;push(@n,$R);}else{print"\nWarning: Unrecognized number.\n";return 0;}$t='NUM';$s='x';$v=0;}sub CaptureWord{my$y=substr($h,$x,512);my$A='';if($y=~m/^([a-zA-Z0-9\_]+)/){$A=$1;if($f&& $A eq'sub'){if(@n&& $n[$#n] ne"\n"){push(@n,"\n");}}push(@n,$A);$x+=length($A)-1;}$t='WORD';$s='x';$v=0;return$A;}sub CaptureHeredoc{my$S='';my$O='';my$B=$x; my$y=substr($h,$x,512);if($y=~m/^\<\<([a-zA-Z\_]{1}[a-zA-Z\_0-9]*)/){$S=$1;$x+=length($S);push(@n,'<<'.$S.';');}elsif($y=~m/^\<\<\s*(['"]{1})/){my$T=$1; my$U=index($y,$T); for($x=$U;$x< length($h);$x++){my$o=substr($h,$x,1);if($o eq $T&& substr($h,$x-1,1)ne"\\"){$S=substr($h,$U,$x-$U-1);last;}}push(@n,'<<'.$T. $S. $T.';');}else{return 0;}my$V=index($h,"\n",$x);if($V<0){$x=$B; print"\nError: Unexpected end of file in the middle of heredoc.\n";return 0;}$x=$V+1;my$W=index($h,"\n$S\n",$x);if($W<0){print"\nError: Heredoc never ends.\n";return 1;}my$X=substr($h,$x,$W-$x);push(@n,$X."\n".$S."\n");$t='HEREDOC';$s='x';$v=0;return 1;}sub CaptureVariable{my$y=substr($h,$x,512);my$Y='';if($y=~m/^([\$\@\%\#]{1,2}[a-zA-Z\_]{1}[a-zA-Z0-9\_]*)/){$Y=$1;}elsif($y=~m/^([\$\@\%]{1}[0-9<>()!?~=:;,.`'%@&#\-\+"\/\]\[\|\\]{1})/){$Y=$1;}elsif($y=~m/^([\$\@\%]{1,2}[a-zA-Z]*[\{\[]{1}[a-zA-Z0-9\_]+[\}\]]{1})/){$Y=$1;}elsif($y=~m/^([\$\@\%]{1,2}\x5E[a-zA-Z0-9\_]+\{[a-zA-Z0-9\_]+\})/){$Y=$1;}elsif($y=~m/^([\$\x5E]{2}[a-zA-Z\_]{1})/){$Y=$1;}else{return 0;}$x+=length($Y)-1;push(@n,ReplaceVariable($Y));$t='VAR';$s='x';$v=0;return 1;}sub ReplaceVariable{my$Z=shift; $e or return$Z;my$aa='';my$O='';if($Z=~m/^([\$\%\@\#]{1,2})([a-zA-Z0-9\_]+)/){$O=$1;$aa=$2;}if(length($aa)==0||length($O)==0){return$Z;}if(exists($w{$aa})){return$O. $w{$aa};}if(index($k," $aa ")>=0){return$Z;}my$ab=scalar keys %w; if(@l< $ab){print"\nWarning: Ran out of variable names! Please increase the value of \$MAXVARS\n";return$Z;}my$ac=$l[$ab]; $w{$aa}=$ac; return$O. $ac;}sub ReplaceVarNameInsideString{my$y=substr($h,$x,512);if($y=~m/^([\$\@\%\#]{1,2})\{([a-zA-Z0-9\_]+)\}/){my$O=$1;my$aa=$2;my$N=$O. $aa;$x+=length($N)+1;$aa=substr(ReplaceVariable($N),1);$_[0] .=$O.'{'.$aa.'}';return 1;}if($y=~m/^([\$\@\%]{1}\#?[a-zA-Z\_]{1}[a-zA-Z0-9\_]*)/){my$N=$1;$x+=length($N)-1;$N=ReplaceVariable($N);$_[0] .=$N;return 1;}if($y=~m/^(\$\x5E[a-zA-Z\_]{1})/){my$N=$1;$x+=length($N)-1;$_[0] .=$N;return 1;}if($y=~m/^(\x24[0-9\<\>\(\)!?~=:;,.^`'%\@&#\+\_\[\]\|\/\\]{1})/){my$N=$1;$x++;$_[0] .=$N;return 1;}return 0;}sub CaptureTail{pop(@n);push(@n,"\n__DATA__");push(@n,substr($h,$x));return 1;}sub CaptureComment{my$W=index($h,"\n",$x); if($W<0){$x=length($h);return 1;}my$ad=substr($h,$x,$W-$x);$x=$W; if(@n==0&&$ad=~m/^\#\!\//){push(@n,$ad."\n");}$r='';$s='x';$v=1;return 1;}sub CaptureString{my$T=substr($h,$x,1);my$ae=$T;my$K=0;for($x++;$x< length($h);$x++){my$o=substr($h,$x,1);if($o eq"\n"){$ae.=($K& 1)?'n': '\\n';$K=0;next;}if(($T eq'"'||$T eq'`')&&($K& 1)==0&&index('$@',$o)>=0){ReplaceVarNameInsideString($ae) and next;}$ae.=$o; if($o eq $T){if(($K& 1)==0){push(@n,$ae);$t='STR';$s='x';$v=0;return 1;}}if($o eq'\\'){$K++;}else{$K=0;}}push(@n,$ae);print"\nWarning: Unterminated string constant.\n";return 1;}sub GenerateShortVariableNames{my$ab=shift;my@af=('a'..'z','A'..'Z','_',0..9);my$ag=join('',@af);my$ah=length($ag);my$ai=$ah-10;my$aa;@af=();for(my$aj=0;$aj< $ai;$aj++){$aa=substr($ag,$aj,1);if(index($k," $aa ")>=0){next;}push(@af,$aa);if(@af>=$ab){return@af;}}for(my$aj=0;$aj< $ai;$aj++){for(my$ak=0;$ak< $ah;$ak++){$aa=substr($ag,$aj,1) .substr($ag,$ak,1);if(index($k," $aa ")>=0){next;}push(@af,$aa);if(@af>=$ab){return@af;}}}for(my$aj=0;$aj< $ai;$aj++){for(my$ak=0;$ak< $ah;$aj++){for(my$al=0;$al< $ah;$ak++){$aa=substr($ag,$aj,1) .substr($ag,$ak,1) .substr($ag,$al,1);if(index($k," $aa ")>=0){next;}push(@af,$aa);if(@af>=$ab){return@af;}}}}return@af;}sub ReadTheEntireFile{my$F=defined$_[0]?$_[0]:'';$F=~tr`<>*?\"\|\x00-\x1F``d; length($F) or return'';-f $F or return'';my$am=-s $F; $am or return'';my$an='';local*FILE;sysopen(FILE,$F,0)or return'';my$ao=sysread(FILE,$an,$am); close FILE;return$an;}sub CreateFile{defined$_[0]or return 0;my$F=shift; $F=~tr`<>*?\"\|\x00-\x1F``d;length($F) or return 0;local*FILE;open(FILE,">$F")or return 0;binmode FILE;foreach(@_){defined$_ and length($_) and print FILE $_;}close FILE;-f $F or return 0;return 1;}