1:
2:
3:
4:
5:
6:
7:
8:
9:

For Zahl1 :=1 to 49-5 do
  For Zahl2 := Zahl1+1 to 49-4 do
    For Zahl3 :=Zahl2+1 to 49-3 do
      For Zahl4 :=Zahl3+1 to 49-2 do
        For Zahl5 :=Zahl4+1 to 49-1 do
          For Zahl6 :=Zahl5+1 to 49-0 do
            begin
            Ausgabe von Zahl1 bis Zahl6
            end;					

1:
2:
3:
4:
5:

aaaa
aaab
aaac
...
99999999					

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:

procedure TForm1.Button1Click(Sender: TObject);
var s:string;
    i:integer;
//****************************************
{}  procedure abc(step,k:integer);
{}  var s_bak:string;
{}      i:integer;
{}  begin
{}    if (step>k) then
{}      begin
{}      if step = Length(Edit1.Text)+1 then//Zeile 11 <----
{}        Memo1.Lines.Add(s);
{}      exit;
{}      end;
{}
{}    for i:=1 to length(edit1.Text) do
{}      begin
{}      s_bak:=s;
{}      s:=s+Edit1.Text[i];
{}      abc(step+1,k);//rekursiv
{}      s:=s_bak;
{}      end;
{}  end;
//****************************************
begin
  for i:=1 to Length(Edit1.text) do
    begin
    s:='';
    abc(1,i);
    end;
  showmessage(IntToStr(Memo1.Lines.Count));
end;					

1:
2:
3:

aaa aab aac aba abb abc aca acb acc
baa bab bac bba bbb bbc bca bcb bcc
caa cab cac cba cbb cbc cca ccb ccc					

1:
2:
3:
4:
5:

abc    =    27 Kombinationen
abcd   =   256    "
abcde  =  3125    "
abcdef = 46656    "
....					

1:
2:
3:
4:
5:

a b c
aa ab ac ba bb bc ca cb cc
aaa aab aac aba abb abc aca acb acc
baa bab bac bba bbb bbc bca bcb bcc
caa cab cac cba cbb cbc cca ccb ccc					

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:

implementation

{$R *.dfm}
var
  count : integer;

procedure TForm1.Button1Click(Sender: TObject);
var s:string;
    i,a,n,Faktor:integer;
//****************************************
{}  procedure abc(step,k:integer);
{}  var
{}    i:integer;
{}  begin
{}    if (step>k) then
{}      begin
{      If Count mod Faktor = 0 then}
{        Memo1.Lines[0]:=s;}
{}      Memo1.Lines.Add(s);
{}      inc(Count);
{}      exit;
{}      end;
{}    for i:=1 to length(edit1.Text) do
{}      begin
{}      s[step]:=Edit1.Text[i];
{}      abc(step+1,k);//rekursiv
{}      end;
{}  end;
//****************************************
begin
  memo1.Clear;
  n := StrToInt(Edit2.text);
  Faktor := 1;
  For i := 1 to n-1 do
    Faktor := Faktor*length(Edit1.Text);
 Count := 0;
 a := 1; //aus 1 bis n
 //Jetzt die unterschiedlichen Lösungen der Länge i erzeugen
 For i := 1 to n do
   begin
   setlength(s,i);
   abc(1,i);
   end;
 showmessage(IntToStr(Count));
end;
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:

Var
  s : String;

  Function AddOne (Const aNumber, aDigits : String; aMaxLen : Integer) : String;
  Var
    i,p : Integer;

  Begin
    i := Length (aNumber);       // Von hinten anfangen
    Result := aNumber;
    While i>0 do begin        
      p := Pos (Result[i], aDigits);    // Welches Zeichen?
      if p = Length (aDigits) Then Begin   // Überlauf ?
        Result [i] := aDigits[1];    // Ja, Ziffer i wieder auf '0'
        dec (i);        // und eine Stelle nach vorne
        End
      Else Begin
        Result [i] := aDigits[p+1];    // Kein überlauf, einfach nächtes Zeichen
        Exit;          // nehmen, das entspricht '+1'
        End;
      End;
    If Length (Result) = aMaxLen Then    // Max. Stellen erreicht?
      Raise EOverflow.Create('Overflow Error'); // Exception auslösen
    result := aDigits[1]+Result;    // Ansonsten einfach eine '1' vorne anstellen.
  End;

begin
  try
    s:=''; 
    repeat
      s := AddOne (s, edit1.text, StrToInt (edit2.text));
      me.lines.add (s);
    until false;
  Except
    End;
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:

Var
  s: String;

  Function AddOne(Const aNumber, aDigits: String; aMaxLen: Integer): String;
  Var
    i, p: Integer;

  Begin
    i := Length(aNumber);
    Result := aNumber;
    While i > 0 Do Begin
      p := Pos(Result[i], aDigits);
      If p = Length(aDigits) Then Begin // Overflow
        Result[i] := aDigits[1];
        dec(i);
      End
      Else Begin
        Result[i] := aDigits[p + 1];
        Exit;
      End;
    End;
    If Length(Result) = aMaxLen Then
      Raise EOverflow.Create('Overflow Error');
    result := aDigits[2] + Result;
  End;

Begin
  Try
    s := Copy(edit1.text, 1, 1);
    While True Do Begin
      me.lines.add(s);
      s := AddOne(s, edit1.text, StrToInt(edit2.text));
    End;
  Except
  End;
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:

function BruteForce(cNb: Cardinal; Const sCh: String): String;
begin
  Result := '';
  while cNb > Length(sCh) do begin
    dec(cNb);
    Result := sCh[cNb mod Length(sCh) + 1] + Result;
    cNb := cNb div Length(sCh);
    end;

  if cNb > 0 then
    Result := sCh[cNb] + Result;
end;

procedure TForm1.FormCreate(Sender: TObject);
const
  MinChars = $1; // von 'a'
  MaxChars = $3; // bis 'zzz'
  CharSet = 'abcdefghijklmnopqrstuvwxyz';
var
  AllKeys: Real;
  sGenPass: String;
  cLastNb: Cardinal;
begin
  Memo1.Clear;
  cLastNb := 1;
  sGenPass := CharSet[1]; // erstes zeichen definieren
  AllKeys := Exp(MaxChars*ln(Length(CharSet))); // berechnen aller permutationen

  while Length(sGenPass) < MinChars do begin   // jetzt bis zum ersten wort vorrücken
    Inc(cLastNb, 1);
    sGenPass := BruteForce(cLastNb, CharSet);
    end;

  // alle möglichkeiten erzeugen
  while (Length(sGenPass) >= MinChars) and (Length(sGenPass) <= MaxChars) do begin
    Memo1.Lines.Add(sGenPass);
    Inc(cLastNb, 1);
    sGenPass := BruteForce(cLastNb, CharSet);
    end;


  showmessage('Berechnete Keys: '+FloatToStr(AllKeys)+' / Tatsächliche Keys: '+IntToStr(Memo1.Lines.Count-1));
end;					

1:
2:
3:
4:
5:
6:
7:
8:

Function AnzahlStellen (N, X : Integer) : Double;
Var
  i : Integer;

Begin
  Result := 1;
  For i:=1 to n do Result := Result + Power (x,i);
End;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

Function AnzahlMoeglichkeiten(Zahllaenge, ZeichenAnzahl : Integer) : Double;   
Var   
  i : Integer;
  Potx : double;
Begin   
  Result := 0.0;   
  Potx := 1.0;
  For i:=1 to ZahlLaenge do 
    begin
    Result := Result + Potx;   
    Potx:= Potx*ZeichenAnzahl;
    end;
End;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:

Function GetpermutationCount2(MinChars, MaxChars, CharLen: Integer) : Double;
Var
  i : Integer;
Begin
  Result := Power(CharLen, MinChars);

  while MinChars < MaxChars do begin
    Inc(MinChars, 1);
    Result := Result + Power(CharLen, MinChars);
    end;
End;