1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:

// ############################################
// #      C R Y P T I O N - U N I T           #
// #                                          #
// #        V E R S I O N  1 . 1              #
// ############################################
//         (c)2005 by Alexander Balke
unit crypt;

interface

uses
  Classes, MD5;

procedure OpenCryptSystem(Password: String);
procedure EncodeBuffer(var Buffer: Array of Byte);
procedure DecodeBuffer(var Buffer: Array of Byte);
procedure CloseCryptSystem;

var
  TranscodeMatrix: Array[0..4095] of Word;
  DecodeTranscodeMatrix: Array[0..4095] of Word;
  CypherPassword: String;

implementation

procedure EncodeBuffer(var Buffer: Array of Byte);
var
  WorkBuffer: Array[0..4095] of Byte;
  I: Integer;
  PassPosition: Integer;
  NewPosition: Integer;
begin
  PassPosition := 0;
  For I := 0 to 4095 do
    begin
      PassPosition := ((PassPosition + 1) mod 32) + 1;
      WorkBuffer[I] := (Buffer[I] + Byte(CypherPassword[PassPosition])) mod 256;
    end;
  For I := 0 to 4095 do
    begin
      NewPosition := TranscodeMatrix[I];
      Buffer[NewPosition] := WorkBuffer[I];
    end;
end;

procedure DecodeBuffer(var Buffer: Array of Byte);
var
  WorkBuffer: Array[0..4095] of Byte;
  I: Integer;
  PassPosition: Integer;
  Value: Integer;
begin
  For I := 0 to 4095 do
    WorkBuffer[DecodeTranscodeMatrix[I]] := Buffer[I];
  PassPosition := 0;
  For I := 0 to 4095 do
    begin
      PassPosition := ((PassPosition + 1) mod 32) + 1;
      Value := (WorkBuffer[I] - Byte(CypherPassword[PassPosition])) mod 256;
      WorkBuffer[I] := Value;
    end;
  For I := 0 to 4095 do
    Buffer[I] := WorkBuffer[I];
end;


procedure OpenCryptSystem(Password: String);
var
  I, J, K: Integer;
  PassPosition: Integer;
  OftenMatrix: Array[0..4095] of Integer;
  Value: Integer;
  Finished: Boolean;
begin
  CypherPassword := MD5Print(MD5String(Password));
  PassPosition := 0;
  For I := 0 to 4095 do
    begin
      PassPosition := ((PassPosition + 2) mod 32) + 1;
      TranscodeMatrix[I] := (((I + Byte(CypherPassword[PassPosition]))) +
                            ((I + Byte(CypherPassword[PassPosition+1])))) mod 4096;
    end;

  For I := 0 to 4095 do
    OftenMatrix[I] := 0;
  For I := 0 to 4095 do
    begin
      Value := TranscodeMatrix[I];
      Inc(OftenMatrix[Value], 1);
    end;
  Finished := False;
  repeat
    For I := 0 to 4095 do
      begin
        if OftenMatrix[I] > 1 then
          begin
            For J := 0 to 4095 do
              if OftenMatrix[J] = 0 then
                begin
                  For K := 0 to 4095 do
                    if TranscodeMatrix[K] = I then
                      begin
                        TranscodeMatrix[K] := J;
                        Inc(OftenMatrix[J]);
                        Dec(OftenMatrix[I]);
                        Break;
                      end;
                  if OftenMatrix[I] = 1 then Break;
                end;
          end;
      end;
    For J := 4095 downto 0 do
      if (OftenMatrix[J] > 1) or (OftenMatrix[J] = 0) then
        Break
      else
        if J = 0 then Finished := True;
  until
    Finished;
  For I := 0 to 4095 do
    DecodeTranscodeMatrix[TranscodeMatrix[I]] := I;
end;

procedure CloseCryptSystem;
var
  I: Integer;
begin
  For I := 0 to 4095 do
    TranscodeMatrix[I] := 0;
  CypherPassword := '';
end;

end.