1:
2:

DAFxüßAv,
VAFfDaGf                    

1:
2:

Grüße,
Yogu                    

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:

const          
  CharCount = 6;
  Chars: array[0..CharCount-1] of Char = ('a', 'd', 'f', 'g', 'v', 'x');   
  UpperChars: array[0..CharCount-1] of Char = ('A', 'D', 'F', 'G', 'V', 'X');

function TMainForm.Decrypt(const S: String): String;
var i, j, k, DecryptedPos, Len: Integer; C, C1, C2: Char; Num: Byte; Found: Boolean;
begin
  SetLength(Result, Length(S));
  DecryptedPos := 1;
  i := 1;
  Len := Length(S);
  while i <= Len do
  begin
    C1 := S[i];
    C2 := S[i+1];

    Found := False;
    for j := 0 to CharCount-1 do
    begin
      if (C1 = Chars[j]) or (C1 = UpperChars[j]) then
      begin
        for k := 0 to CharCount-1 do
        begin
          if (C2 = Chars[k]) or (C2 = UpperChars[k]) then
          begin
            Num := j*CharCount + k;

            if Num < 26 then
            begin
              if C2 in ['a', 'd', 'f', 'g', 'v', 'x'] then
                C := Chr(97+Num)
              else
                C := Chr(65+Num);
            end
            else
              C := Chr(22+Num);

            Result[DecryptedPos] := C;
            inc(DecryptedPos);
            inc(i, 2);  
            Found := True;
            Break;
          end;
        end;
      end;
      if Found then Break;
    end;

    if not Found then
    begin
      Result[DecryptedPos] := S[i];
      inc(DecryptedPos);
      inc(i);
    end;
  end;

  SetLength(Result, DecryptedPos-1);
end;                    

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:

function Index(C: Char): Integer; inline;
const Delta = Integer('a') - Integer('A');
begin
  case C of
    'A': Result := 0;
    'D': Result := 1;
    'F': Result := 2;
    'G': Result := 3;
    'V': Result := 4;
    'X': Result := 5;
    'a': Result := Delta + 0;
    'd': Result := Delta + 1;
    'f': Result := Delta + 2;
    'g': Result := Delta + 3;
    'v': Result := Delta + 4;
    'x': Result := Delta + 5;
  else
    Result := -1;
  end;
end;

function Khacrypt(const S: String): String;
var i, j, Len, Num, Num2: Integer; C1, C2: Char;
begin
  SetLength(Result, Length(S));
  i := 1;
  j := 1;
  Len := Length(S);
  while i <= Len do
  begin
    C1 := S[i];
    Num := Index(C1);
    if (Num >= 0) and (Num < 6) then
    begin
      C2 := S[i + 1];
      // Häfigkeitsanalyse ^^
      Num2 := Index(C2);
      if Num2 >= 0 then
      begin
        Num := 6 * Num + Num2 + Integer('A');
        if Num <= Integer('z') then
          Result[j] := Chr(Num)
        else
          Result[j] := Chr(Integer('0') + Num - Integer('z') - 1);
        Inc(i, 2);
        Inc(j);
        continue;
      end;
    end;
    Result[j] := C1;
    Inc(i);
    Inc(j);
  end;
  SetLength(Result, j);
end;                    

1:
2:
3:

Benchmark, 100000 Iterationen
Yogu: 343 ms
Meins: 140 ms                    

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:

const
  CharList1: array[65..122] of Byte = (0, 0, 0, 1, 0, 2, 3, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 4, 0, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 2, 3,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 5, 0, 0);
  CharList2: array[65..122] of Byte = (6, 0, 0, 7, 0, 8, 9, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 10, 0, 11, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 2, 3,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 5, 0, 0);
  CharTable: array[0..5] of array[0..11] of Char =
    (('a', 'b', 'c', 'd', 'e', 'f', 'A', 'B', 'C', 'D', 'E', 'F'),
     ('g', 'h', 'i', 'j', 'k', 'l', 'G', 'H', 'I', 'J', 'K', 'L'),
     ('m', 'n', 'o', 'p', 'q', 'r', 'M', 'N', 'O', 'P', 'Q', 'R'),
     ('s', 't', 'u', 'v', 'w', 'x', 'S', 'T', 'U', 'V', 'W', 'X'),
     ('y', 'z', ' ', ' ', ' ', ' ', 'Y', 'Z', '0', '1', '2', '3'),
     (' ', ' ', ' ', ' ', ' ', ' ', '4', '5', '6', '7', '8', '9'));

var
  CurIn, CurOut, Len: Integer;
  Chars: array of Char;
  tmp: string;
  StartTime, EndTime, Freq: Int64;
  i: Integer;
begin
  QueryPerformanceFrequency(Freq);
  QueryPerformanceCounter(StartTime);

  for i := 1 to 1000 do
  begin
    tmp := memInput.Text;
    Len := Length(tmp);
    SetLength(Chars, Len);
    CopyMemory(@Chars[0], @tmp[1], Len);
    CurIn := 0;
    CurOut := 0;
    while CurIn < Len do
    begin
      if not (Chars[CurIn] in ['a'..'z', 'A'..'Z']) then
      begin
        Chars[CurOut] := Chars[CurIn];
        Inc(CurIn);
      end
      else
      begin
        Chars[CurOut] := CharTable[CharList1[Ord(Chars[CurIn])]]
          [CharList2[Ord(Chars[CurIn + 1])]];
        Inc(CurIn, 2);
      end;
      Inc(CurOut);
    end;
    SetLength(Chars, CurOut);
    SetLength(tmp, CurOut);
    CopyMemory(@tmp[1], @Chars[0], CurOut);
    memOutput.Text := tmp;
  end;

  QueryPerformanceCounter(EndTime);
  ShowMessage(FormatFloat('0.000', (EndTime - StartTime) / Freq) + ' ms');
end;                    

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:

const
  CharList1: array[65..122] of Byte = (0, 0, 0, 1, 0, 2, 3, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 4, 0, 5, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 2, 3,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 5, 0, 0);
  CharList2: array[65..122] of Byte = (6, 0, 0, 7, 0, 8, 9, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 10, 0, 11, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 2, 3,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 5, 0, 0);
  CharTable: array[0..5] of array[0..11] of Char =
    (('a', 'b', 'c', 'd', 'e', 'f', 'A', 'B', 'C', 'D', 'E', 'F'),
     ('g', 'h', 'i', 'j', 'k', 'l', 'G', 'H', 'I', 'J', 'K', 'L'),
     ('m', 'n', 'o', 'p', 'q', 'r', 'M', 'N', 'O', 'P', 'Q', 'R'),
     ('s', 't', 'u', 'v', 'w', 'x', 'S', 'T', 'U', 'V', 'W', 'X'),
     ('y', 'z', ' ', ' ', ' ', ' ', 'Y', 'Z', '0', '1', '2', '3'),
     (' ', ' ', ' ', ' ', ' ', ' ', '4', '5', '6', '7', '8', '9'));

var
  EndAddr: Integer;
  CurIn, CurOut: ^Char;
  tmp: string;
  StartTime, EndTime, Freq: Int64;
  i: Integer;
begin
  QueryPerformanceFrequency(Freq);
  QueryPerformanceCounter(StartTime);

  for i := 1 to 1000 do
  begin
    tmp := memInput.Text;
    EndAddr := Integer(Pointer(tmp)) + Length(tmp);
    CurIn := Pointer(tmp);
    CurOut := CurIn;
    while Integer(CurIn) < EndAddr do
    begin
      if not (CurIn^ in ['a'..'z', 'A'..'Z']) then
      begin
        CurOut^ := CurIn^;
        Inc(CurIn);
      end
      else
      begin
        CurOut^ := CharTable[CharList1[Ord(CurIn^)]]
          [CharList2[Ord(Char(Pointer(Integer(CurIn) + 1)^))]];
        Inc(CurIn, 2);
      end;
      Inc(CurOut);
    end;
    SetLength(tmp, Integer(CurOut) - Integer(Pointer(tmp)));
    memOutput.Text := tmp;
  end;

  QueryPerformanceCounter(EndTime);
  ShowMessage(FormatFloat('0.000', (EndTime - StartTime) / Freq) + ' ms');                    

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:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:

procedure TfrmMain.btnSpeedClick(Sender: TObject);
const
  CharList: array[Char] of Byte = (
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

    0, 1, 0, 0, 2, 0, 3, 4, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 5, 0, 6, 0, 0, 0, 0, 0, 0, 0,
    0, 1, 0, 0, 2, 0, 3, 4, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 5, 0, 6, 0, 0, 0, 0, 0, 0, 0,

    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,

    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
    );

  CharTable: array[0..35] of Char = (
    'A', 'B', 'C', 'D', 'E', 'F',
    'G', 'H', 'I', 'J', 'K', 'L',
    'M', 'N', 'O', 'P', 'Q', 'R',
    'S', 'T', 'U', 'V', 'W', 'X',
    'Y', 'Z', '0', '1', '2', '3',
    '4', '5', '6', '7', '8', '9'
    );

var
  EndAddr: Integer;
  CurIn, CurOut: ^Char;
  tmp: string;
  StartTime, EndTime, Freq: Int64;
  i: Integer;
begin
  QueryPerformanceFrequency(Freq);
  QueryPerformanceCounter(StartTime);

  for i := 1 to 1000 do
  begin
    tmp := memInput.Text;
    asm
      PUSH  ESI
      PUSH  EDI
      PUSH  EBX

      //CurIn := Pointer(tmp);
      MOV    ESI, DWORD PTR [tmp]
      //CurOut := CurIn;
      MOV    EDI, ESI
      //ECX := Length(tmp);
      MOV    ECX, DWORD PTR [ESI-4]

      MOV    EBX, OFFSET CharList

      TEST  ECX, ECX
      JMP    @@CheckLoop

@@StartLoop:
      //AL := CurIn^;
      //Inc(CurIn);
      LODSB
      MOV    AH, AL

      //Check AL in ['a'..'z', 'A'..'Z'] AND transform char into correct offset
      XLATB

      OR    AL, AL
      JNZ    @@Got1

      //CurOut^ := CurIn^;
      //Inc(CurOut);
      MOV    AL, AH
      STOSB
      JMP    @@ECycle

@@Got1:
      MOV    EDX, EAX
      //AL := CurIn^;
      //Inc(CurIn);
      LODSB
      MOV    AH, AL

      //Adjust input byte counting
      DEC    ECX

      //Check AL in ['a'..'z', 'A'..'Z'] AND transform char into correct offset
      XLATB
      OR    AL, AL
      JNZ    @@Got2

      //Second byte is not valid: Leave unchanged
      MOV    AL, DH
      STOSB
      MOV    AL, AH
      STOSB
      JMP    @@ECycle

@@Got2:
      //DL := ((DL * 2-2)+DL-1)*2
      DEC    DL
      AND    EDX, 7
      LEA    EDX, DWORD PTR [EDX+EDX*2]
      ADD    EDX, EDX

      //Decode table position into char
      MOV    EBX, OFFSET CharTable
      ADD    AL, DL
      DEC    AL
      XLATB
      MOV    EBX, OFFSET CharList

      //Fix Lowercase\Uppercase
      AND    AH, $20
      ADD    AL, AH

      //Store decrypted char
      STOSB

@@ECycle:
      //Adjust Input Byte counting
      DEC    ECX
@@CheckLoop:
      JNZ    @@StartLoop

      MOV    DWORD PTR [CurOut], EDI

      POP    EBX
      POP    EDI
      POP    ESI
    end;
    SetLength(tmp, Integer(CurOut) - Integer(Pointer(tmp)));
    memOutput.Text := tmp;
  end;

  QueryPerformanceCounter(EndTime);
  ShowMessage(FormatFloat('0.000', (EndTime - StartTime) / Freq) + ' ms');
end;                    

1:

CurOut^ := CharTable[CharList1[Ord(CurIn^)]]