enc_functions.pas

Pascal/Delphi源代码混淆工具

unit Enc_Functions;

interface

uses
    SysUtils;

procedure PutOnALine(const FPath: String);
procedure RandomTuneCase(const FPath: String; EncodeString: Boolean);

implementation

uses ENC_Main;

function CharUpCase(const SrcChar: Char): Char;
begin
     Case SrcChar of
        'a'..'z': Result := Chr(Ord(SrcChar) - 32);
        else Result := SrcChar;
     end;
end;

function CharLowCase(const SrcChar: Char):Char;
begin
     Case SrcChar of
        'A'..'Z': Result := Chr(Ord(SrcChar) + 32);
        else Result := SrcChar;
     end;
end;

function ParseSpace(const Source: String): String;
var
   TmpStr: String;
   Index, FoundAt: Integer;
begin
     TmpStr := Trim(Source);
     For Index := 1 to Length(TmpStr) do
         begin
              FoundAt := Pos('  ', TmpStr);
              While FoundAt <> 0 do
                    begin
                         Delete(TmpStr, FoundAt, 1);
                         FoundAt := Pos('  ', TmpStr);
                    end;
         end;
     For Index :=1 to Length(TmpSTr) do
         if TmpStr[Index] = ' ' then
            begin
                 if Index > 2 then
                    if TmpStr[Index - 2] = '$' then Continue;
                 if Index > 1 then
                    Case TmpStr[Index - 1] of
                       '#', '$', '(', ')', '*', ',',
                       '.', ':', ';', '[', ']', '/',
                       '{', '}', '<', '>', '-', '=',
                       '+', '@': begin
                                      Delete(TmpStr, Index, 1);
                                      Continue;
                                 end;
                    end;
                 if Index < Length(TmpStr) then
                    Case TmpStr[Index + 1] of
                       '#', '$', '(', ')', '*', ',',
                       '.', ':', ';', '[', ']', '/',
                       '{', '}', '<', '>', '-', '=',
                       '+', '@': begin
                                      Delete(TmpStr, Index, 1);
                                      Continue;
                                 end;
                    end;
            end;
     Result := Trim(TmpStr);
end;

function GetAWord(var FSrc: TextFile; Original: String): String;
var
   Flag: Boolean;
   TmpChar: Char;
   TmpStr: String;
begin
     TmpStr := '';
     Result := '';
     Flag := False;
     While not Eof(FSrc) do
           begin
                Read(FSrc, TmpChar);
                if Flag then
                   Case TmpChar of
                       #13, #10: Break;
                       else TmpStr := TmpStr + TmpChar;
                   end
                   else
                   if TmpChar = '/' then
                      if Length(TmpStr) > 0 then
                         if TmpStr[Length(TmpStr)] = '/' then
                            begin
                                 Flag := True;
                                 TmpStr := TmpStr + '/';
                            end
                            else TmpStr := TmpStr + '/'
                         else TmpStr := TmpStr + '/'
                      else
                      begin
                           Case TmpChar of
                              '#', '$', '(', ')', '*', ',',
                              '.', ':', ';', '[', ']', '@',
                              '{', '}', '<', '>', '-', '=',
                              '+': While True do
                                         if Length(TmpStr) > 0 then
                                            if TmpStr[Length(TmpStr)] = ' ' then
                                               if Length(TmpStr) > 2 then
                                                  if TmpStr[Length(TmpStr) - 2] <> '$' then
                                                     Delete(TmpStr, Length(TmpStr), 1)
                                                     else Break
                                                  else Delete(TmpStr, Length(TmpStr), 1)
                                               else Break
                                             else Break;
                              #13: Continue;
                              #10: begin
                                        if Length(TmpStr) > 0 then
                                           Case TmpStr[Length(TmpStr)] of
                                              '#', '$', '(', ')', '*', ',',
                                              '.', '/', ':', ';', '[', ']',
                                              '{', '}', '<', '>', '-', '=',
                                              '+', '@': ;
                                              else
                                              if Length(Original) > 0 then
                                                 if Original[Length(Original)] <> ' ' then
                                                    TmpStr := TmpStr + ' ';
                                           end
                                           else
                                           if Length(Original) > 0 then
                                              Case Original[Length(Original)] of
                                                 '#', '$', '(', ')', '*', ',',
                                                 '.', '/', ':', ';', '[', ']',
                                                 '{', '}', '<', '>', '-', '=',
                                                 '+', '@', ' ': ;
                                                 else TmpStr := TmpStr + ' ';
                                              end;
                                        Continue;
                                   end;
                              ' ': if Length(TmpStr) > 0 then
                                      Case TmpStr[Length(TmpStr)] of
                                         '#', '$', '(', ')', '*', ',',
                                         '.', '/', ':', ';', '[', ']',
                                         '{', '}', '<', '>', '-', '=',
                                         '+', '@', ' ': Continue;
                                      end
                                      else Continue;
                           end;
                           TmpStr := TmpStr + TmpChar;
                           if TmpChar = ';' then Break;
                      end;
           end;
     Result := TmpStr;
end;

procedure PutOnALine(const FPath: String);
var
   Position: Integer;
   FFrom, FTemp: TextFile;
   TmpStr, TmpWord: String;
begin
     AssignFile(FFrom, FPath);
     AssignFile(FTemp, ExtractFilePath(FPath) + ChangeFileExt(ExtractFileName(FPath), '.tmp'));
     Reset(FFrom);
     ReWrite(FTemp);
     TmpStr := '';
     While not Eof(FFrom) do
           begin
                While (Length(TmpStr) < 128) and not Eof(FFrom) do
                      begin
                           TmpWord := GetAWord(FFrom, TmpStr);
                           Position := Pos('//', TmpWord);
                           if Position = 0 then
                              TmpStr := TmpStr + ParseSpace(TmpWord)
                              else
                              begin
                                   TmpStr := TmpStr + Trim(Copy(TmpWord, 1, Position - 1));
                                   TmpWord := Trim(Copy(TmpWord, Position, Length(TmpWord) - Position + 1));
                                   TmpStr := TmpStr + #13#10 + TmpWord + #13#10;
                              end;
                      end;
                TmpStr := ParseSpace(TmpStr);
                WriteLn(FTemp, TmpStr);
                TmpStr := '';
           end;
     CloseFile(FFrom);
     CloseFile(FTemp);
     DeleteFile(FPath);
     RenameFile(ExtractFilePath(FPath) +
                ChangeFileExt(ExtractFileName(FPath),
                              '.tmp'),
                FPath);
end;

procedure RandomTuneCase(const FPath: String; EncodeString: Boolean);
var
   TmpChar: Char;
   Flag, Flag_0: Boolean;
   FFrom, FTemp: TextFile;
begin
     Randomize;
     Flag := False;
     AssignFile(FFrom, FPath);
     AssignFile(FTemp, ExtractFilePath(FPath) + ChangeFileExt(ExtractFileName(FPath), '.tmp'));
     Reset(FFrom);
     ReWrite(FTemp);
     Flag_0 := False;
     While not Eof(FFrom) do
           begin
                Read(FFrom, TmpChar);
                if TmpChar = '''' then Flag := not Flag;
                if EncodeString then
                   if Flag then
                      if TmpChar <> '''' then
                         begin
                              Flag_0 := False;
                              Write(FTemp, '#' + IntToStr(Ord(TmpChar)));
                         end
                         else
                         Flag_0 := True
                      else
                      if TmpChar <> '''' then
                         begin
                              Case Random(100) of
                                 0..50: Write(FTemp, CharLowCase(TmpChar));
                                 51..100: Write(FTemp, CharUpCase(TmpChar));
                              end;
                              Flag_0 := False;
                         end
                         else
                         if Flag_0 then
                            begin
                                 Flag_0 := False;
                                 Write(FTemp, '#0');
                            end
                            else
                   else
                   if Flag then
                      Write(FTemp, TmpChar)
                      else
                      Case Random(100) of
                         0..50: Write(FTemp, CharLowCase(TmpChar));
                         51..100: Write(FTemp, CharUpCase(TmpChar));
                      end;
           end;
     CloseFile(FFrom);
     CloseFile(FTemp);
     DeleteFile(FPath);
     RenameFile(ExtractFilePath(FPath) +
                ChangeFileExt(ExtractFileName(FPath),
                              '.tmp'),
                FPath);
end;

end.