DBR Delphi-Ecke

// Im Netz findet man mehrmals einen Code zur Generierung "sprechbarer"
// Passwörter. Allerdings steht auf deutschen Seiten auch die englische
// Version und außerdem erzeugt er auch solche Worte wie "cucucucu", bei
// welchem man schon von fern durch einen Blick auf die Tastatur das
// Wort während der Eingabe ausspähen kann. Deshalb habe ich den Code
// ein wenig abgeändert.

// Getestet mit D4 unter XP

// Variante 1:
// (Die erzeugten Wörter klingen wie die Namen der japanischen Sumo-Ringer)

function PassW: string; 
const 
  kon: array[0..14] of Char = 'dfghjklmnprstwz'; 
  vok: array[0..4] of Char = 'aueio'; 
var 
  i: integer; 
  c, v, m: string; 
begin 
  result := ''; 
  randomize; 
  m := ''; 
  for i := 1 to 4 do 
  begin 
    c := kon[random(15)]; 
    if (i = 1) then begin 
      if c = 'p' then c := 'b'; 
    end else 
      if c = 'z' then c := 'sch'; 
    result := result + c; 
    repeat 
      v := vok[random(5)]; 
    until v <> m; 
    m := v; 
    result := result + v; 
  end; 
end; 
 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  showmessage(passw); 
end; 


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

// Variante 2:
// Um die Sicherheit der Passwörter zu erhöhen, wird das letzte Zeichen
// eine Ziffer. Das kann man sich gerade noch so merken :-)

function PassW: string; 
const 
  kon: array[0..14] of Char = 'dfghjklmnprstwz'; 
  vok: array[0..4] of Char = 'aueio'; 
  zhl: array[0..9] of Char = '0123456789'; 
var 
  i: integer; 
  c, v, m: string; 
begin 
  result := ''; 
  randomize; 
  m := ''; 
  for i := 1 to 4 do 
  begin 
    c := kon[random(15)]; 
    if (i = 1) then begin 
      if c = 'p' then c := 'b'; 
    end else 
      if c = 'z' then c := 'sch'; 
    result := result + c; 
    repeat 
      if (i = 4) then v := zhl[random(10)] else 
        v := vok[random(5)]; 
    until v <> m; 
    m := v; 
    result := result + v; 
  end; 
end; 
 
procedure TForm1.Button3Click(Sender: TObject); 
begin 
  showmessage(passw); 
end;

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

// Variante 3:
// Je länger ein Passwort ist, desto sicherer ist es. Deshalb verwenden manche
// Leute ganze Sätze. Aus diesem Grund habe ich mir hier einen neuen Code
// ausgedacht, der mehr oder minder sinnvolle Sätze bildet:

type 
  fall = array[0..2] of string; 
 
  sub = record 
    wort: string; 
    a: fall; 
  end; 
 
  vrb = record 
    wort: string; 
    fall: byte; 
  end; 
 
var 
  prpo: array[0..4] of string = ('der', 'die', 'das', 'dem', 'den'); 
  subj: array[0..14] of sub; 
  verb: array[0..14] of vrb; 
  m: integer = maxint; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  with subj[0] do begin 
    wort := 'Putzfrau'; 
    a[0] := prpo[1]; 
    a[1] := prpo[0]; 
    a[2] := prpo[1]; 
  end; 
  with subj[1] do begin 
    wort := 'Vertreter'; 
    a[0] := prpo[0]; 
    a[1] := prpo[3]; 
    a[2] := prpo[4]; 
  end; 
  with subj[2] do begin 
    wort := 'Eichhörnchen'; 
    a[0] := prpo[2]; 
    a[1] := prpo[3]; 
    a[2] := prpo[2]; 
  end; 
  with subj[3] do begin 
    wort := 'Programmierer'; 
    a[0] := prpo[0]; 
    a[1] := prpo[3]; 
    a[2] := prpo[4]; 
  end; 
  with subj[4] do begin 
    wort := 'Bettlerin'; 
    a[0] := prpo[1]; 
    a[1] := prpo[0]; 
    a[2] := prpo[1]; 
  end; 
  with subj[5] do begin 
    wort := 'Kind'; 
    a[0] := prpo[2]; 
    a[1] := prpo[3]; 
    a[2] := prpo[2]; 
  end; 
  with subj[6] do begin 
    wort := 'Pferd'; 
    a[0] := prpo[2]; 
    a[1] := prpo[3]; 
    a[2] := prpo[2]; 
  end; 
  with subj[7] do begin 
    wort := 'Hausarzt'; 
    a[0] := prpo[0]; 
    a[1] := prpo[3]; 
    a[2] := prpo[4]; 
  end; 
  with subj[8] do begin 
    wort := 'Kuh'; 
    a[0] := prpo[1]; 
    a[1] := prpo[0]; 
    a[2] := prpo[1]; 
  end; 
  with subj[9] do begin 
    wort := 'Lehrerin'; 
    a[0] := prpo[1]; 
    a[1] := prpo[0]; 
    a[2] := prpo[1]; 
  end; 
  with subj[10] do begin 
    wort := 'Polizistin'; 
    a[0] := prpo[1]; 
    a[1] := prpo[0]; 
    a[2] := prpo[1]; 
  end; 
  with subj[11] do begin 
    wort := 'Vater'; 
    a[0] := prpo[0]; 
    a[1] := prpo[3]; 
    a[2] := prpo[4]; 
  end; 
  with subj[12] do begin 
    wort := 'Kindermädchen'; 
    a[0] := prpo[2]; 
    a[1] := prpo[3]; 
    a[2] := prpo[2]; 
  end; 
  with subj[13] do begin 
    wort := 'Kätzchen'; 
    a[0] := prpo[2]; 
    a[1] := prpo[3]; 
    a[2] := prpo[2]; 
  end; 
  with subj[14] do begin 
    wort := 'General'; 
    a[0] := prpo[0]; 
    a[1] := prpo[3]; 
    a[2] := prpo[4]; 
  end; 

  with verb[0] do begin 
    wort := 'sitzt auf'; 
    fall := 1; 
  end; 
  with verb[1] do begin 
    wort := 'spuckt auf'; 
    fall := 2; 
  end; 
  with verb[2] do begin 
    wort := 'liebt'; 
    fall := 2; 
  end; 
  with verb[3] do begin 
    wort := 'betrachtet'; 
    fall := 2; 
  end; 
  with verb[4] do begin 
    wort := 'steht neben'; 
    fall := 1; 
  end; 
  with verb[5] do begin 
    wort := 'verachtet meistens'; 
    fall := 2; 
  end; 
  with verb[6] do begin 
    wort := 'beißt'; 
    fall := 2; 
  end; 
  with verb[7] do begin 
    wort := 'imponiert'; 
    fall := 1; 
  end; 
  with verb[8] do begin 
    wort := 'hasst'; 
    fall := 2; 
  end; 
  with verb[9] do begin 
    wort := 'lächelt über'; 
    fall := 2; 
  end; 
  with verb[10] do begin 
    wort := 'schmiegt sich an'; 
    fall := 2; 
  end; 
  with verb[11] do begin 
    wort := 'denkt oft an'; 
    fall := 2; 
  end; 
  with verb[12] do begin 
    wort := 'vertraut'; 
    fall := 1; 
  end; 
  with verb[13] do begin 
    wort := 'schubst'; 
    fall := 2; 
  end; 
  with verb[14] do begin 
    wort := 'streichelt'; 
    fall := 2; 
  end; 
end; 
 
function pwsatz: string; 
var 
  i, j, k: integer; 
begin 
  randomize; 
  repeat 
    i := random(length(subj)); 
  until i <> m; 
  m := i; 
  result := subj[i].a[0] + #32 + subj[i].wort + #32; 
  result[1] := upcase(result[1]); 
  j := random(length(verb)); 
  result := result + verb[j].wort + #32; 
  repeat 
    k := random(length(subj)); 
  until (i <> k) and (subj[i].a[0] <> subj[k].a[0]); 
  result := result + subj[k].a[verb[j].fall] + #32 + subj[k].wort + '.'; 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  Label1.caption := pwsatz; 
end;