// Es wird mit einfachen Mitteln eine Verschlüsselung von Strings erreicht.
// Siehe dazu auch
Dateien verschlüsseln
// Für Textdateien aber siehe unten Punkt 9, Punkt 10 und Punkt 11


// 1. Text mittels Tabelle verschlüsseln

// Getestet mit D4 unter Win98  und  D2010 unter W7

// Eine simple Art der Verschlüsselung. Allerdings kann das Ergebnis über
// die Häufigkeit der auftretenden Zeichen geknackt werden. Reicht aber allemal
// aus, Text für andere Computer-User unleserlich zu machen. Die Zeichen in der
// Tabelle müssen natürlich nicht in der Reihenfolge stehen wie im Beispiel.
// Logischerweise braucht man für Ver- und Entschlüsselung die gleiche Tabelle.
// Beim ersten Durchlauf wird verschlüsselt, beim nächsten wieder
// entschlüsselt.

const 
  Tabelle = #10#32#13#9 + 
    '(+.%ßaÄäBbCcDdEeFfGgHhIiJjKkLlMmNnOoÖöPp=?-/;,!:*' + 
    '"_QqRrSsTtUuÜüVvWwXxYyZz0987654321A)'; 
 
function crypt(s: string): string; 
var lg, ltab, stelle, such: integer; 
begin 
  result := s; 
  lg := length(result); 
  if lg = 0 then exit; 
  ltab := length(Tabelle); 
  stelle := 1; 
  while stelle <= lg do begin 
    such := 1; 
    while (Tabelle[such] <> result[stelle]) and (such <= ltab) do inc(such); 
    if such <= ltab then result[stelle] := Tabelle[ltab - such + 1]; 
    inc(stelle); 
  end; 
end; 
// Beispielaufruf
 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  Memo1.text := crypt(Memo1.text); 
end;

//---------------------------------------------------------------------

// 2. Verschlüsselungsmethode "V128"

// Getestet mit D4 unter Win98

// Hier handelt es sich wieder um eine Tabellen-Verschlüsselung.
// Allerdings ist die Häufigkeit einzelner Buchstaben nicht mehr auszumachen.
// Die Methode ist direkt abgeleitet von der Base64-Codierung, arbeitet aber
// via Zufallsgenerator mit zwei unterschiedlichen Tabellen. Somit hat man eine
// höhere Verschlüsselungsrate und dem verschlüsselten Text ist nicht
// anzusehen, dass eigentlich nur 64 Zeichen verwendet wurden. Die Tabellen
// kann
(ja sollte) man sich selbst aufbauen. Da aber nicht alle Zeichen
// enthalten sein dürfen, kann man mit der Funktion "
TabelleOK" zunächst die
// Zeichen überprüfen. Der verschlüsselte Text ist 1/3 größer als das Original.

const 
 Tab1 = 
  '4F2!"#N$%(S+/1,Ñ' + 
  '7Æ8:0;<M=>?@A«Cu' + 
  'KgTG9EH)I-L*OØQP' + 
  'UVèX[Ya£bcÙdehij'; 
 Tab2 = 
  'tÞkÌnpÐqr¬yzÖÇÜs' + 
  '¤äf.×\]{D|Z}l~¡ü' + 
  'm¢J5¥¦§ö©ox®°B±µ' + 
  '»Wv¿6ÀÁÂRÄÈ3Òàwß'; 
 
  V128: array[0..127] of char = Tab1 + Tab2; 
 
function TabelleOK: byte; 
const vbtn = [0..31, 38, 39, 127..159]; 
var i, j: integer; 
begin 
  result := 1; 
  for i := 0 to 127 do 
    if ord(V128[i]) in vbtn {verbotene Zeichen} 
     then exit; 
  result := 2; 
  for i := 0 to 126 do 
    for j := i + 1 to 127 do 
      if V128[i] = V128[j] {doppelte Zeichen} 
       then exit; 
  result := 0; 
end; 
 
function encode(txt: string): string; 
var 
  g: string; 
  i, lg, lt: integer; 
  function zufall: integer; 
  begin 
    result := random(2) * 64; 
  end; 
begin 
  result := ''; 
  if txt = '' then exit; 
  randomize; 
  lt := length(txt); 
  i := lt mod 3; 
  if i = 0 then g := '' else 
    g := stringofchar(#0, 3 - i); 
  lg := length(g); 
  txt := txt + g; 
  inc(lt, lg); 
  i := 1; 
  while i < lt do begin 
    result := result 
      + V128[zufall + ord(txt[i]) shr 2] 
      + V128[zufall + (ord(txt[i]) and 3) shl 4 or ord(txt[i + 1]) shr 4] 
      + V128[zufall + (ord(txt[i + 1]) and 15) shl 2 or ord(txt[i + 2]) shr 6] 
      + V128[zufall + ord(txt[i + 2]) and 63]; 
    inc(i, 3); 
  end; 
  delete(result, 1 + length(result) - lg, lg); 
end; 


function decode(txt: string): string; 
var 
  i, j, lt: integer; 
  a: array of byte; 
begin 
  result := ''; 
  i := 1; 
  while i <= length(txt) do begin 
    if (pos(txt[i], V128) = 0) then 
      delete(txt, i, 1) else inc(i); 
  end; 
  if txt = '' then exit; 
  lt := length(txt); 
  setlength(a, lt + 3); 
  for i := 1 to lt do begin 
    j := (pos(txt[i], V128) - 1); 
    a[i - 1] := j - ord(j > 63) * 64; 
  end; 
  i := 0; 
  while i < lt do begin 
    result := result 
      + chr((a[i] shl 2) or (a[i + 1] shr 4)) 
      + chr((a[i + 1] shl 4) or (a[i + 2] shr 2)) 
      + chr(((a[i + 2] and 3) shl 6) or (a[i + 3] and 63)); 
    inc(i, 4); 
  end; 
  a := nil; 
end; 
 
// ---Beispielaufrufe --- 
 
// verschlüsseln 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  label1.caption := ''; 
  case TabelleOK of 
    1: showmessage('V128 enhält verbotene Zeichen'); 
    2: showmessage('V128 enhält doppelte Zeichen'); 
  else label1.caption := encode(Edit1.text); 
  end; 
end; 
 
// entschlüsseln 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  label2.ShowAccelChar := false; // falls "&" im entschlüsselten Text 
  label2.caption := decode(label1.caption); 
end; 

//---------------------------------------------------------------------

// 3. Text zu Zahlen verschlüsseln

// Getestet mit D4 unter Win98  und  D2010 unter W7

// Um bei der Verschlüsselung zu vermeiden, dass Steuerzeichen entstehen
// (z.B. #0 als ungewolltes Stringende oder #13 als ungewollter Zeilenumbruch),
// werden die bereits verschlüsselten Buchstaben anschließend in eine
// Zahlenfolge umgewandelt, was man als zusätzliche Verschlüsselung ansehen
// kann. Allerdings ist der verschlüsselte String dreimal länger als das
// Original.

const 
  passwort = '1#-5ab8.*Z1'; // oder sonstwas 
 
var 
  sss: string; 
 
function verschluessele(zuverschluesseln, schluessel: string): string; 
var x, y, lg: integer; 
begin 
  result := ''; 
  try 
    if length(zuverschluesseln) > 0 then begin 
      y := 1; 
      lg := length(schluessel); 
      for x := 1 to length(zuverschluesseln) do begin 
        result := result + formatfloat('000', ord(zuverschluesseln[x]) 
          xor ord(schluessel[y])); 
        if y = lg then y := 1 
        else inc(y); 
      end; 
    end; 
  except result := ''; end; 
end; 
 
function entschluessele(zuentschluesseln, schluessel: string): string; 
var x, y, lg: integer; 
begin 
  result := ''; 
  try 
    lg := length(zuentschluesseln); 
    if (lg > 0) and (lg mod 3 = 0) then begin 
      y := 1; 
      while y < lg do begin 
        result := result + chr(strtoint(copy(zuentschluesseln, y, 3))); 
        inc(y, 3); 
      end; 
      y := 1; 
      lg := length(schluessel); 
      for x := 1 to length(result) do begin 
        result[x] := chr(ord(result[x]) xor ord(schluessel[y])); 
        if y = lg then y := 1 
        else inc(y); 
      end; 
    end; 
  except result := ''; end; 
end; 
 
// Beispielaufruf 
procedure TForm1.Button5Click(Sender: TObject); 
begin 
  sss := verschluessele(Edit1.Text, passwort); 
// showmessage(sss); 
end; 
 
procedure TForm1.Button6Click(Sender: TObject); 
begin 
  sss := entschluessele(sss, passwort); 
// showmessage(sss); 
end;

//---------------------------------------------------------------------

// 4. Strings verschlüsseln mit Zahlen-Schlüssel

// Getestet mit D4 unter Win98

// Wen es stört, dass bei Methode 1 der verschlüsselte Text 3 x länger wird
// als der Originalstring, der kann die folgende Methode verwenden, welche
// durch Addition
(bzw. Subtraktion) von $E0 vermeidet, dass Zeichen unterhalb
// von #32 entstehen. Allerdings sind im Schlüssel nur Ziffern erlaubt,
// wodurch sich die Sicherheit etwas verringert.

function Ver_Ent_Schl(txt: string; schlsl: longword; verschl: boolean): string; 
var 
  x, p, n: Integer; 
  schluessel: string; 
begin 
  result := ''; 
  p := 0; 
  schluessel := inttostr(schlsl); 
  for x := 1 to length(txt) do begin 
    inc(p); 
    if p > length(schluessel) then p := 1; 
    if verschl then begin 
      n := ord(txt[x]) + ord(schluessel[p]); 
      if n > 255 then n := n - $E0; 
    end else begin 
      n := ord(txt[x]) - ord(schluessel[p]); 
      if n < 32 then n := n + $E0; 
    end; 
    result := result + chr(n); 
  end; 
end; 
 
const passw: longword = 165738904; 
 
// Verschlüsseln (verschl=True) 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  label1.caption := Ver_Ent_Schl(Edit1.text, passw, True); 
end; 
 
// Entschlüsseln (verschl=False) 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  Label2.caption := Ver_Ent_Schl(Label1.caption, passw, False); 
end;

//---------------------------------------------------------

// 5. Verschlüsselung plus Zufall

// Getestet mit D4 unter Win98  und  D2010 unter W7

// Der folgende Code arbeitet unter Zuhilfenahme des Zufallsgenerators.
// Der selbe Text liefert jedesmal ein anderes Teilergebnis, wenn er mit dem
// selben Schlüssel neu codiertt wird. Der verschlüsselte String wird
// doppelt so lang wie das Original.

function verschl(txt, schl: string): string; 
var x, y, lg, n: integer; 
begin 
  result := ''; 
  lg := length(schl); 
  y := 1; 
  randomize; 
  for x := 1 to length(txt) do begin 
    n := (byte(txt[x]) xor byte(schl[y])) or 
      (((random(32) shl 8) and 15872) or 16384); 
    if lo(n) < 32 then n := n or 384; 
    if y = lg then y := 1 
    else inc(y); 
    result := result + chr(lo(n)) + chr(hi(n)); 
  end; 
end; 
 
function entschl(txt, schl: string): string; 
var x, y, lg, n: integer; 
begin 
  if not odd(length(txt)) then begin 
    result := ''; 
    lg := length(schl); 
    y := 1; 
    x := 1; 
    while x < length(txt) do begin 
      n := (byte(txt[x]) or (byte(txt[x + 1]) shl 8)); 
      if n and 256 > 0 then n := n and 127 
      else n := n and 255; 
      result := result + chr(n xor byte(schl[y])); 
      if y = lg then y := 1 
      else inc(y); 
      inc(x, 2); 
    end; 
  end else result := txt; 
end; 
 
// Beispielaufruf 
const schlssl = 'h*09mÖ-X#z&5%A@+0'; 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  edit1.text := verschl(edit1.text, schlssl); 
end; 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  edit1.text := entschl(edit1.text, schlssl); 
end;

//---------------------------------------------------------

// 6. Verschlüsseln mit zwei Passwörtern

// Getestet mit D4 unter Win98

// Manchmal ist das "Vier-Augen-Prinzip" vorgeschrieben. Das bedeutet, dass
// aus Sicherheitsgünden zwei von einander unabhängige Personen je ein
// geheimes Passwort eingeben müssen, um Text zu ver- oder entschlüsseln.
// Um die Sicherheit zu erhöhen, habe ich zusätzlich den Zufallsgenerator
// eingesetzt. Man hat zwei Verschlüsselungs-Methoden zur Auswahl: FALSE und
// TRUE. Wenn mit TRUE verschlüsselt wurde, muss mit FALSE entschlüsselt werden
// und umgekehrt.

function 
  Ver_Ent_Schl(txt: string; Methode: boolean; schl_1: Longint; schl_2: DWord): 
    string; 
var 
  x, p, n, lg: Integer; 
  s: string; 
begin 
  p := 0; 
  result := ''; 
  randseed := schl_1; 
  s := inttostr(schl_2); 
  lg := length(s); 
  for x := 1 to length(txt) do begin 
    inc(p); 
    if p > length(s) then p := 1; 
    if Methode then begin 
      n := ord(txt[x]) + ord(s[p]) + random($70 + lg); 
      if n > 255 then n := n - $E0; 
    end else begin 
      n := ord(txt[x]) - ord(s[p]) - random($70 + lg); 
      if n < 32 then n := n + $E0; 
    end; 
    result := result + chr(n); 
  end; 
end; 
 
// Beispielaufruf 
const 
  Key1 = 195678; 
  Key2 = 9854539; 
// Verschlüsseln 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  Edit1.text := Ver_Ent_Schl(Edit1.text, FALSE, key1, key2); 
end; 
 
// Entschlüsseln 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  Edit1.text := Ver_Ent_Schl(Edit1.text, TRUE, key1, key2); 
end;

//---------------------------------------------------------

// 7. Verschlüsseln mit mehreren Passwörtern

// Getestet mit D4 unter Win98

// Hiermit kann man einen String mit einer beliebigen Anzahl Keys verschlüsseln
//
(ob's Sinn macht, weiß ich nicht so genau). Verschlüsselungsrelevant ist
// neben den Schlüsselwörtern auch die Ziffernanzahl im jeweiligen Schlüssel.
// Man hat zwei Verschlüsselungs-Methoden zur Auswahl: FALSE und TRUE. Wenn
// mit TRUE verschlüsselt wurde, muss mit FALSE entschlüsselt werden und
// umgekehrt.

function 
  Ver_Ent_Schl(const txt: string; Methode: boolean; schlssl: array of DWord): 
    string; 
var 
  n, h, i, j: integer; 
  ss: array of string; 
  lg, zl: array of byte; 
begin 
  result := txt; 
  h := high(schlssl); 
  setlength(ss, h + 1); 
  setlength(zl, h + 1); 
  setlength(lg, h + 1); 
  for i := 0 to h do begin 
    ss[i] := inttostr(schlssl[i]); 
    lg[i] := length(ss[i]); 
    zl[i] := 1; 
  end; 
  for i := 1 to length(txt) do begin 
    n := byte(txt[i]); 
    for j := 0 to h do begin 
      if methode then begin 
        n := n + byte(ss[j][zl[j]]) + lg[j]; 
        if n > 255 then n := n - $E0; 
      end else begin 
        n := n - byte(ss[j][zl[j]]) - lg[j]; 
        if n < 32 then n := n + $E0; 
      end; 
      inc(zl[j]); 
      if zl[j] > lg[j] then zl[j] := 1; 
    end; 
    result[i] := char(n); 
  end; 
  zl := nil; 
  lg := nil; 
  ss := nil; 
end; 
 
// Verschlüsseln mit 3 Schlüsseln 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  Edit1.text := Ver_Ent_Schl(Edit1.text, TRUE, [10296, 7913, 98765342]); 
end; 
 
// Entschlüsseln mit 3 Schlüsseln 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  Edit1.text := Ver_Ent_Schl(Edit1.text, FALSE, [10296, 7913, 98765342]); 
end; 

//---------------------------------------------------------

// 8. "3Z"-Verschlüsselung

// Getestet mit D4 unter Win98

// Der Code ist für Leute, die sich keine langen Passwörter merken können.
// Das Passwort besteht nämlich aus
3 Zeichen. Hat die Variable "was" den Wert
//
TRUE, dann wird verschlüsselt, bei FALSE wird entschlüsselt. ACHTUNG! Wenn
//
ein bereits verschlüsselter Text nochmals verschlüsselt wird, kommt es zu
//
Verlusten.

function VE3Z(txt, schl: string; was: boolean): string; 
var 
  i, z: integer; 
  a: array[0..2] of integer; 
begin 
  if length(schl) > 2 then begin 
    result := ''; 
    z := ord(was) * 2 - 1; 
    for i := 0 to 2 do 
      a[i] := ord(schl[i + 1]) - $F0; 
    for i := 1 to length(txt) do begin 
      if abs(a[0]) >= a[2] then a[1] := -a[1]; 
      result := result + chr((ord(txt[i]) + a[0] * z) mod $100); 
      inc(a[0], a[1]); 
    end; 
  end else result := txt; 
end; 
 
 
// Verschlüsseln 
procedure TForm1.Button5Click(Sender: TObject); 
begin 
  memo1.text := VE3Z(memo1.text, 'ö!A', true); 
end; 
 
// Entschlüsseln 
procedure TForm1.Button6Click(Sender: TObject); 
begin 
  memo1.text := VE3Z(memo1.text, 'ö!A', false); 
end;

//---------------------------------------------------------

// 9. Text-Verschlüsselung mit Sicherheitspasswort

// Getestet mit D4 unter Win98

// Hiermit können Texte (Textdateien) verschlüsselt werden, wobei
// nach der Verschlüsselung ein sogenanntes Sicherheitspasswort mit
// 10 Stellen zurückgegeben wird. Das Passwort, mit dem verschlüsselt wird,
// kann 3 bis 15 Zeichen haben und ist maßgeblich an der Erzeugung des
// Sicherheitspasswortwes beteiligt, kann aber nicht zur Entschlüsselung
// benutzt werden. Das bedeutet, dass jeder verschlüsselte Text sein eigenes
// 10-stelliges Passwort hat, und nur damit kann der Text auch wieder
// entschlüsselt werden. Außerdem ist per Zufall gesichert, dass der gleiche
// Text immer ein anderes Verschlüsselungsergebnis gibt, auch wenn er mit dem
// gleichen Passwort verschlüsselt wurde. Ebenfalls ist das Sicherheitspasswort
// pro Verschlüsselung neu und einmalig.

function EnCrypt(const txt, pw: string; out newpw: string): string; 
var 
  x: integer; 
  v: cardinal; 
  P1, P2: PByte; 
  b: byte; 
  function MyRange(const von, bis: Integer): Integer; 
  begin 
    Result := Random(bis - von + 1) + von; 
  end; 
  function Zahl(pw: string): cardinal; 
  var x: integer; 
  begin 
    Result := 0; 
    if length(pw) < 3 then 
      raise exception.create('Das Kennwort muss mindestens 3 Zeichen haben!') 
    else pw := copy(pw, 1, 15); 
    for x := 1 to length(pw) do 
      Result := Result + ord(pw[x]) * (Random(7) + 1); 
  end; 
  function rechnen(const v: cardinal): cardinal; 
  begin 
    Result := (Random(v) + v * v * 13) or Random(v); 
  end; 
begin 
  Randomize; 
  v := rechnen(zahl(pw)); 
  setlength(Result, length(txt) * 2); 
  P1 := @txt[1]; 
  P2 := @Result[1]; 
  for x := 1 to length(txt) do begin 
    b := (v xor P1^) and $FF; 
    if b < 32 then begin 
      P2^ := MyRange(201, 255); 
      inc(P2); 
      P2^ := b + 32; 
    end else begin 
      p2^ := MyRange(32, 126); 
      inc(P2); 
      P2^ := b; 
    end; 
    inc(P2); 
    inc(P1); 
  end; 
  newpw := inttostr(v); 
  for x := 1 to length(newpw) do 
    if odd(x) then 
      newpw[x] := chr(ord(newpw[x]) + 49 + Random(2) * 10); 
  while length(newpw) < 10 do insert(chr(Random(3) + 120), 
      newpw, random(length(newpw) + 1) + 1); 
end; 
 
function DeCrypt(const txt: string; pw: string): string; 
var 
  x: Integer; 
  v: cardinal; 
  P1, P2: PByte; 
begin 
  try 
    x := 1; 
    pw := lowercase(pw); 
    while x <= length(pw) do 
      if ord(pw[x]) > 119 then delete(pw, x, 1) 
      else inc(x); 
    for x := 1 to length(pw) do 
      if odd(x) then begin 
        pw[x] := chr(ord(pw[x]) - 49 - ord(ord(pw[x]) > 106) * 10); 
      end; 
    v := strtoint(pw); 
    setlength(Result, length(txt) div 2); 
    P1 := @txt[1]; 
    P2 := @Result[1]; 
    x := 1; 
    while x < length(txt) do begin 
      if P1^ > 200 then begin 
        inc(P1); 
        P2^ := (v xor (P1^ - 32)) and $FF; 
      end else begin 
        inc(P1); 
        P2^ := (v xor P1^) and $FF; 
      end; 
      inc(P1); 
      inc(P2); 
      inc(x, 2); 
    end; 
  except 
    raise exception.create('Entschlüsselung nicht möglich!'); 
  end; 
end; 
 
// Beispielaufruf 
 
var 
  pwx: string; // Sicherheitspasswort
 
procedure TForm1.Button4Click(Sender: TObject); 
begin 
  Memo1.lines.loadfromfile('c:\Test.txt'); 
  Memo2.text := EnCrypt(Memo1.text, 'Mein Passwort', pwx); 
  Label1.caption := pwx; 
  Memo2.lines.savetofile('c:\verschl.txt'); 
end; 
 
procedure TForm1.Button5Click(Sender: TObject); 
begin 
  Memo1.lines.loadfromfile('c:\verschl.txt'); 
  Memo2.text := DeCrypt(Memo1.text, pwx); 
end;

//---------------------------------------------------------

// 10. Text-Verschlüsselung mit Vorbehandlung

// Getestet mit D4 unter Win98  und  D2010 unter W7

// Hiermit können Texte (Textdateien) verschlüsselt werden, wobei
// zunächst Buchstabenkombinationen durch Einzelzeichen ersetzt werden.
// Wichtig ist, dass im Array
#10 und #13 an der richtigen Stelle stehen
// und dass das Array
nicht mehr als 31 Elemente hat.

const 
  min = 1; 
  max = 31; 
 
var 
  pwx: string = '#Mein Passwort#'; 
 
  aos: array[min..max] of string = 
  ('heit', 'keit', 'ung', 'le', 'ch', 'be', 'ei', 'em', 'ck', #10, 
    'ie', 'eu', #13, 'tt', 'ff', 'en', 'nn', 'gg', 'eh', 'ne', 'ig', 
    're', 'oh', 'an', 'la', 'mm', 'li', 'ss', 'er', 'au', 'he'); 
 
function verschl(txt, schl: string): string; 
var 
  x, y, lg, n: integer; 
begin 
  result := ''; 
  if txt = '' then exit; 
  for x := min to max do  
    txt := stringreplace(txt, aos[x], chr(x), [rfreplaceall]); 
  lg := length(schl); 
  y := min; 
  randomize; 
  for x := min to length(txt) do begin 
    n := (byte(txt[x]) xor byte(schl[y])) or 
      (((random(32) shl 8) and 15872) or 16384); 
    if lo(n) < 32 then n := n or 384; 
    if y = lg then y := min 
    else inc(y); 
    result := result + chr(lo(n)) + chr(hi(n)); 
  end; 
end; 
 
function entschl(txt, schl: string): string; 
var 
  x, y, lg, n: integer; 
begin 
  result := ''; 
  if txt = '' then exit; 
  lg := length(schl); 
  y := min; 
  x := min; 
  while x < length(txt) do begin 
    n := (byte(txt[x]) or (byte(txt[succ(x)]) shl 8)); 
    if n and 256 > 0 then n := n and 127 
    else n := n and 255; 
    result := result + chr(n xor byte(schl[y])); 
    if y = lg then y := min 
    else inc(y); 
    inc(x, 2); 
  end; 
  for x := min to max do 
    result := stringreplace(result, chr(x), aos[x], [rfreplaceall]); 
end; 
 

// Beispiel: 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  Memo1.lines.loadfromfile('c:\Test.txt'); 
end; 
 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  Memo2.Text := verschl(Memo1.Text, pwx); 
end; 
 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  Memo3.Text := entschl(Memo2.Text, pwx); 
end;

//---------------------------------------------------------

// 11. Simple Text-Verschlüsselung

// Getestet mit D2010 unter W7

// Das älteste bekannte militärische Verschlüsselungsverfahren wurde von den Spartanern
// bereits vor mehr als 2500 Jahren angewendet. Zur Verschlüsselung diente ein (Holz-)Stab
// mit einem bestimmten Durchmesser (Skytale). Um eine Nachricht zu verfassen, wickelte der
// Absender einen Streifen wendelförmig um die Skytale, schrieb die Botschaft längs des
// Stabs auf das Band und wickelte es dann ab. Das Band ohne den Stab wird dem Empfänger
// überbracht. Fällt das Band in die falschen Hände, so kann die Nachricht nicht gelesen
// werden, da die Buchstaben scheinbar willkürlich auf dem Band angeordnet sind. Der
// richtige Empfänger des Bandes konnte die Botschaft mit einer identischen Skytale
// (einem Stab mit dem gleichen Durchmesser) lesen. Der Durchmesser des Stabes ist somit
// der geheime Schlüssel bei diesem Verschlüsselungsverfahren.
// Der Code empfindet das Verfahren nach, wobei die Variable "Diameter" den Stab-Durchmesser
// repräsentiert und Sender sowie Empfänger bekannt sein muss. Der Wert muss mindestens
// 2 betragen.

var 
  Diameter: Word; 
 
function Skytale(const txt: String; out upshot: String): Byte; 
var 
  lg, i, st, x: Integer; 
  hlp, s: string; 
begin 
  try 
    lg := Length(txt); 
    if lg = 0 then 
    begin 
      Result := 1; 
      exit; 
    end; 
    if Diameter > lg div 2 then 
    begin 
      Result := 2; 
      exit; 
    end; 
    if Diameter < 2 then 
    begin 
      Result := 3; 
      exit; 
    end; 
    if odd(lg) then 
    begin 
      s := txt + #32; 
      inc(lg); 
    end 
    else 
      s := txt; 
    upshot := ''; 
    st := Diameter; 
    for i := 1 to lg do 
    begin 
      x := ord(s[st]); 
      if x = 255 then 
        x := 31; 
      hlp := chr(x + 1); 
      upshot := upshot + hlp; 
      inc(st, Diameter); 
      if st > lg then 
        st := st - succ(lg); 
      if st < 1 then 
        st := Diameter; 
    end; 
    s := ''; 
    Result := 0; 
  except 
    Result := 255; 
  end; 
end; 
 
function SkytaleInterpret(const txt: String; out upshot: String): Byte; 
var 
  lg, st, i, x: Integer; 
begin 
  try 
    lg := Length(txt); 
    if lg = 0 then 
    begin 
      Result := 1; 
      exit; 
    end; 
    if (Diameter > lg div 2) or (Diameter < 2) then 
    begin 
      Result := 2; 
      exit; 
    end; 
    st := Diameter; 
    upshot := txt; 
    for i := 1 to lg do 
    begin 
      x := pred(ord(txt[i])); 
      if x = 31 then 
        x := 255; 
      upshot[st] := chr(x); 
      inc(st, Diameter); 
      if st > lg then 
        st := st - succ(lg); 
      if st < 1 then 
        st := Diameter; 
    end; 
    Result := 0; 
  except 
    Result := 255; 
  end; 
end; 
 
 
// --- Beispielaufrufe --- 
 
// Verschlüsseln 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  s: string; 
  b: Byte; 
begin 
  Screen.Cursor := crHourGlass; 
  Button1.Enabled := False; 
  Application.ProcessMessages; 
  Memo1.Lines.BeginUpdate; 
  // Memo1.Text:='Das ist ein Test'; 
  Memo1.Lines.LoadFromFile('C:\test.txt'); 
 
  Diameter := 7; // z.B. 
 
  b := Skytale(Memo1.Text, s); 
  case b of 
    0: 
      Memo1.Text := s; 
    1: 
      Memo1.Text := 'Keinen Text zum Verschlüsseln gefunden'; 
    2: 
      Memo1.Text := 'Diameter im Verhältnis zum Text zu groß'; 
    3: 
      Memo1.Text := 'Diameter muss mindestens 2 sein'; 
    else 
      Memo1.Text := 'Unerwarteter Fehler'; 
    end; 
  s := ''; 
  Memo1.Lines.EndUpdate; 
  Screen.Cursor := crDefault; 
  Button1.Enabled := True; 
end; 
 
// Entschlüsseln 
procedure TForm1.Button2Click(Sender: TObject); 
var 
  b: Byte; 
  s: string; 
begin 
  Button2.Enabled := False; 
  Application.ProcessMessages; 
 
  Diameter := 7; 
 
  b := SkytaleInterpret(Memo1.Text, s); 
  case b of 
    0: 
      Memo2.Text := s; 
    1: 
      Memo2.Text := 'Keinen Text zum Entschlüsseln gefunden'; 
    2: 
      Memo2.Text := 'Falscher Wert für Diameter'; 
    else 
      Memo2.Text := 'Unerwarteter Fehler'; 
    end; 
  s := ''; 
  Button2.Enabled := True; 
end;




Zugriffe seit 6.9.2001 auf Delphi-Ecke