Discussion :

[BATiViR]

Bonjour a tous,
j'aimerai créer une application qui test toutes les possibilités possibles avec ABCDEFGHIJKLMNOPQRSTUVW0123456789 en lui indiquant le nombre de caractères et qu'il m'affiche tout sa dans un TMemo. Il faudrait que je fasse une pause dans la boucle quand voulu et que je continue la boucle aussi quand voulu... Quelqu'un voit comment faire??

J'aimerai par exemple 111, 112, 113... 121, 122, 123... aa1, aa2.... comme sa pour toutes les possibilités possible si quelqu'un a une fonction ou voit comment le faire merci d'avance

[SylvainClip]

euh je comprends rien, tu veux testé quoi ?!

"les possibilités possibles" .. d'accord

Précise ta question on comprend pas bien non ?

édit : j'y vois un peu plus clair... mais... poulalala....

[BATiViR]

désolé... Enfaite j'aimerai afficher toutes les possibilités possibles avec tel carractere... Par exemple je selectionne les caractères [a] , [b] et [c] et je veux afficher toutes les possibilités alors i va m'afficher :
aaa
aab
aac
aba
abb
abc
aca
acb
acc
baa
bab
...

jusqu'à avoir afficher toutes les possibilités... Il faudrait que je fasse une fonction mai je sais pas par ou commencer

[ShaiLeTroll]

Très Amusantes ces "Possibilités Possibles" ... Tu devrais voir au sujet de la Combinatoire et des Probabilités qui te donnera les formules pour générer les "combinaisons possibles" de n tirage dans un ensemble

sinon, c'est une combinatoire de 3 sur ABC..789, c'est n'est que trois boucles "for", avec laquelle tu défini la borne de début et de fin

en peudo code (quoi que en D2006 la syntaxe existe non ?)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For A in [A, B, C] do 
  For B in [A, B, C] do 
    For C in [A, B, C] do

[BATiViR]

Justement mon problème est que je ne veux pas mettre 20 boucles... je devrais faire une fonction ou je peux lui dire le nombre de caractères et le les caractères voulu pour calculer les possibilités... par exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

function possibilites(NbrCaracteres, Caracteres)

ce qui me permetrai de faire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

possibilites(2, abc)

ce qui me renverrai
aa
ab
ac
ba
bb
bc
ca
cb
cc

[ShaiLeTroll]

Tu veux une combinatoire toujours à 3, ou nombre de digit variable ?
(le premier 3 boucle imbriqués, le second récursivité probable)

[BATiViR]

Nombre de digit variable comme expliqué plu haut

[Ludo_360]

utile pour tester mots de passe...

[gb_68]

Bonjour,
je pense que le mieux est de se servir de l'étape NbrCaracteres-1 pour trouver l'étape NbrCaracteres.

Un petit code (en Delphi 2006 avec des for in )

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
type
  TElt = char;
  TEnsElt = set of TElt;
 
function possibilites(NbrCaracteres : Cardinal  ;  Caracteres : TEnsElt): TStrings;
var
  i: Integer; AncList, NouvList : TStringList; Elt : TElt; Chaine : string;
begin
  if NbrCaracteres = 0 then
  begin
    Result := TStringList.Create;
    Exit;
  end;
 
  AncList := nil;
 
  // pour un caractère
  NouvList := TStringList.Create;
  for Elt in Caracteres do
       NouvList.Add(Elt);
 
  for i := 2 to NbrCaracteres do
  Begin
    AncList.Free;
    AncList  := NouvList;
    NouvList := TStringList.Create;
    for Chaine in AncList do
     for Elt in Caracteres do
       NouvList.Add(Elt+Chaine);
  End;
  AncList.Free;
  Result := NouvList;
end;

Exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
var Resultat : TStrings; Str : string;
begin
   Resultat := possibilites(4,['a','b','c']);
   for Str in Resultat do
    Writeln(Str);
   Readln;
   Resultat.Free;
end.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
aaaa
baaa
caaa
abaa
bbaa
cbaa
acaa
bcaa
ccaa
.....

[BATiViR]

J'ai pleind d'erreur sur ta fonction... J'ai trouver une source en c++ qui est nettement plus simple si quelqu'un voit comment faire quelque chose de ce genre ou plus simple... :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
void CheckCaracteres(AnsiString& strSerial, unsigned int N)
{
const char* caracteres = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ";
char ChecKey[50];
  for (const char* c = caracteres; c != caracteres + 36; ++c)
  {
    unsigned int L = strSerial.Length();
    strSerial[N] = *c;
    if (N < L)
    {
      CheckCaracteres(strSerial, N + 1);
    }
    else
    {
      Memo1->Lines->Add(strSerial);
    }
  }
}

[BATiViR]

personne ne voit comment facilité la chose??

[sjrd]

Adapte ceci

c'était il y a moins d'une semaine !

[Fabrice ROUXEL 1]

possibilites(2, abc)

le nombre de combinaisons sera: 3^ 2 = 9
possibilites(3, abc) -> 3^3 = 27
possibilites(4, abcdefg) -> 7^4 = 2401

[gb_68]

nettement plus simple

Elle pas si compliquée ma méthode : je sauvegarde juste les résultats intermédiaires (dans une TStringList) pour ne pas les recalculer (ce que fais la version récursive).
ex :
Liste "possibilites(1, ab)" : a b
Liste "possibilites(2, ab)" : a+a b+a | a+b b+b
Liste "possibilites(3, ab)" : a+aa b+aa | a+ba b+ba | a+ab b+ab | a+bb b+bb
etc...

utile pour tester mots de passe...

Surtout quand dans la version C++ qui est proposée (sans doute C++Builder) on peut lire "strSerial" (tu prepares une attaque brute force ou quoi ? )

Parce que ça m'amuse, voila une version récursive basée sur la version C++ (sauf que je décrémente Nb quand en C++ N est incrémenté)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
function possibilites2(NbrCaracteres : Cardinal  ; const Caracteres : String): TStrings;
var StrTemp : string;
   Procedure possRec( Nb : Cardinal);
   var Car : char;
   BEGIN
      if Nb = 0 then
          Result.Add(StrTemp)
      else
        for Car in Caracteres do
        begin
          StrTemp[Nb] := Car ;
          possRec(Nb-1);
        end;
   END;
begin
  SetLength( StrTemp , NbrCaracteres );
  Result :=  TStringList.Create;
  possRec(NbrCaracteres);
end;

exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
var Resultat : TStrings; Str : string;
begin
   Resultat := possibilites2(3,'abce');
   for Str in Resultat do
    Writeln(Str);
   Readln;
   Resultat.Free;
end.

REM : possibilites et possibilites2 compilent parfaitement sous Turbo Delphi 2006
Pour les Delphi antérieurs, il faut juste transformer les boucles for in en for ou while classiques
(les for in c'était pour ShaiLeTroll)

en peudo code (quoi que en D2006 la syntaxe existe non ?)

et leurs transformations n'est franchement pas compliquées ...

[sjrd]

Surtout quand dans la version C++ qui est proposée (sans doute C++Builder) on peut lire "strSerial" (tu prepares une attaque brute force ou quoi ? )

Bah euh, je dis ça je dis rien mais... s'il a vraiment des serial de 20 caractères, chacun pris dans [A-Z0-9], ça lui fait 26^20 possibilités, c'est pas demain la veille qu'il l'aura finie sa brute force En admettant qu'il puisse en tester 100 000 par seconde, il en a pour... 10^15... ans !

Et puis c'est marrant les brute force

[ShaiLeTroll]

J'ai testé 5 parmis "ABCDEFGHIJKLMNOPQRSTUVW0123456789", c'est assez copieux en terme de temps, faudrait trouver un algo optimisé, pour occuper 39 135 392 de chaines de 5 char, donc allouer d'un coup la mémoire ce qui serait plus performant que l'allocation de chaine, le résultat serait évidemment moins évident à lire ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
function CalculCombinatoire(CombinaisonLength: Integer; CombinaisonSet: string): TStringDynArray;
var
  IndexResult: Integer;
  OffSet: Integer;
  Threshold, iStep: Integer;
  IndexCS, LenCS: Integer;
  PointerResult: TIntegerDynArray;
var
  I: Integer;
begin
  LenCS := Length(CombinaisonSet);
  SetLength(Result, Round(Power(LenCS, CombinaisonLength)));
  SetLength(PointerResult, Length(Result));
  for I := Low(Result) to High(Result) do
  begin
    SetLength(Result[I], CombinaisonLength);
    PointerResult[I] := Integer(PChar(Result[I])) - 1;
  end;
 
  Threshold := Length(Result);
  for OffSet := 1 to CombinaisonLength do
  begin
    Threshold := Threshold div LenCS;
    iStep := 0;
    IndexCS := 1;
    for IndexResult := Low(Result) to High(Result) do
    begin
      PChar(PointerResult[IndexResult]+OffSet)^ := CombinaisonSet[IndexCS];
 
      Inc(iStep);
      if iStep = Threshold then
      begin
        iStep := 0;
        Inc(IndexCS);
        if IndexCS > LenCS then
          IndexCS := 1;
      end;
    end;
  end;
end;

[Gilbert Geyer]

S'il s'agit de trouver toutes les combinaisons possibles, par exemple de abc
c'est à dire la série :
abc
acb
bac
bca
cba
cab
c'est qu'on est en train de réinventer l'anagramme : Taper les mots magiques anagramme delphi sous Google il y'a plein d'algos ... voici un exemple avec 3 manières de combiner les caractères.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
unit uAnagramme;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ComCtrls;
 
type
  TForm1 = class(TForm)
    bCombine: TSpeedButton;
    bCombine1: TSpeedButton;
    bCombine2: TSpeedButton;
    Edit1: TEdit;
    Label1: TLabel;
    red1: TRichEdit;
    procedure bCombineClick(Sender: TObject);
    procedure bCombine1Click(Sender: TObject);
    procedure bCombine2Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.DFM}
 
// 1ère Méthode : Par rotations successives vers la gauche.
 
procedure combinaison1(st, tete: string);
var i: integer; tete_local, reste_local: string;
begin
  if length(st) = 1 then Form1.red1.lines.add(tete + st)
  else
    for i := 1 to length(st) do
    begin
      tete_local := st[1];
      reste_local := copy(st, 2, length(st) - 1);
      combinaison1(reste_local, tete + tete_local);
      st := reste_local + tete_local;
    end;
end;
 
procedure combinaison2(st, tete: string); // déclinée à partir de combinaison1
var       i: integer;
begin     if length(st) = 1 then Form1.red1.lines.add(tete + st)
          else for i := 1 to length(st) do
               begin combinaison2(copy(st, 2, length(st) - 1), tete + st[1]);
                     st := copy(st, 2, length(st) - 1) + st[1];
               end;
end;
 
// 2ème Méthode :
// on prend un mot et on permute sa première lettre avec chacune des autres lettres.
// Ensuite pour chacun des nouveaux mots obtenus, on ne touche pas à la première
// lettre et à partir de la deuxième lettre on refait les permutations entre la deuxième
// lettre et toutes les autres lettres jusqu'à la fin; ensuite pour chacun des nouveaux
// mots obtenus, on ne touche pas à la deuxième lettre et à partir de la troisième
// lettre on refait les permutations entre la troisième lettre et toutes les autres
// lettres jusqu'à la fin; on voit donc la récursivité :
 
procedure combinaisons(ch : string);
var l: byte;
 
  procedure EchangeCar(var ch: string; i, j: byte);
  var car: char;
  begin
    if i <> j then
    begin
      car := ch[i];
      ch[i] := ch[j];
      ch[j] := car;
    end
  end;
 
  procedure anagram(ch: string; i: byte);
  var j: byte;
  begin
    if i = l then Form1.red1.lines.add(ch)
    else
      for j := i to l do
      begin
        EchangeCar(ch, i, j);
        Anagram(ch, i + 1);
        EchangeCar(ch, i, j);
      end;
  end;
 
begin
  l := length(ch);
  anagram(ch, 1);
end;
 
 
procedure TForm1.bCombineClick(Sender: TObject);
begin     red1.clear;
          combinaisons(edit1.text);
          label1.caption:=intToStr(red1.lines.count)+' anagrammes';
end;
 
procedure TForm1.bCombine1Click(Sender: TObject);
begin     red1.clear;
          combinaison1(edit1.text,'');
          label1.caption:=intToStr(red1.lines.count)+' anagrammes';
end;
 
procedure TForm1.bCombine2Click(Sender: TObject);
begin      red1.clear;
           combinaison2(edit1.text,'');
           label1.caption:=intToStr(red1.lines.count)+' anagrammes';
end;
 
end.

... c'est rapide avec 3 lettres mais avec tout l'alphabet cela risque d'être longuet d'autant plus que les 3 algo créent les combinaisons et les affichent en même temps dans le RichEdit ... ce serait à mon avis plus rapide en stockant les combinaisons dans une StringList et d'attendre la fin des routines pour placer cette StringList dans le RichEdit d'affichage.

[Gilbert Geyer]

Comme il a été dit "boucles longues" dans l'intulé de la discussion, j'ai fait des tests de vitesse avec le code ci-joint qui est une version améliorée du code d'Anagrammes d'hier (ajout de chronomètres, et ajout d'une Approche B qui améliore l'approche du code d'hier que je nomme ici par A :

Résultats comparatifs des tests :

1er exemple : Pour les 5040 anagrammes de 'ABCDEFG' soit 7 char :

- Approche A : avec affichage direct dans RichEdit : mis en moyenne 6sec 434 ms.
- Approche B : avec affichage différé via une StringList et un MemoryStream : mis en moyenne 83 ms, soit environ 77,5 fois plus rapide.

2ème exemple : Pour les 40320 anagrammes de 'ABCDEFGH' soit 8 char

- Approche A : mis 7min 14sec !!!
- Approche B : mis en moyenne 628 ms soit environ 691 fois plus rapide.

Autre constat : Pour les 362880 anagrammes de 'ABCDEFGHJ' soit 9 char :
ma bécane tousse 'Mémoire insuffisante' même en fermant toutes les applis.

Améliorations à envisager : En conséquence, et vu notamment qu'il s'agit de sortir les anagrammes de ABCDEFGHIJKLMNOPQRSTUVW0123456789 (bigre le nombre de combinaisons !) vaut mieux envoyer les string directement dans un TFileStream plutôt que via la StringList et le MemoryStream (qui actuellement sont simultanément en mémoire) et de n'afficher dans la RichEdit qu'une fraction ... puisque de toutes façons on ne peut pas les voir tous simultanément à l'écran.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
unit uAnagramme2; // Version améliorée pour gains de vitesse considérables
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ComCtrls;
 
type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    red1: TRichEdit;
    GroupBox1: TGroupBox;
    bCombine1A: TSpeedButton;
    bCombine2A: TSpeedButton;
    bCombineA: TSpeedButton;
    labChrono0A: TLabel;
    labChrono1A: TLabel;
    labChrono2A: TLabel;
    GroupBox2: TGroupBox;
    bCombine1B: TSpeedButton;
    bCombine2B: TSpeedButton;
    bCombineB: TSpeedButton;
    labChrono0B: TLabel;
    labChrono1B: TLabel;
    labChrono2B: TLabel;
    procedure bCombineAClick(Sender: TObject);
    procedure bCombine1AClick(Sender: TObject);
    procedure bCombine2AClick(Sender: TObject);
    procedure bCombineBClick(Sender: TObject);
    procedure bCombine1BClick(Sender: TObject);
    procedure bCombine2BClick(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.DFM}
 
// ---- Chronomètres : ---------------------------------------------------------
 
type   oChrono = object
                    TopDeb,Duree : longWord; // milliSecondes
                    Cadran       : tLabel;
                    procedure Top(iCadran : tLabel);
                    procedure Mis;
                              // Affiche par ex 12h 15min   : si >= 1 heure
                              //                15min 22sec : si >= 1 min
                              //                22sec 33ms  : si >= 1 sec
                              //                33ms        : si >= 1 ms
                    end;
 
procedure oChrono.Top(iCadran : tLabel);
begin     Cadran:=iCadran; Cadran.caption:='';
          TopDeb:=GetTickCount;
end;
 
procedure oChrono.Mis;
var       msp,he,mi,se,ms : longWord; s : string;
 
begin     Duree:= GetTickCount-TopDeb; // millisecondes passées
          //Duree:=12*60*60*1000 + 15*60*1000 + 4*1000 + 45; //12h 15m 4s 45ms
          msp:=Duree;
          ms:= msp mod 1000; msp:= msp div 1000;
          se:= msp mod 60;   msp:= msp div 60;
          mi:= msp mod 60;   msp:= msp div 60;
          he:= msp mod 60;   s:='';
          if he<>0 then begin s:=s+intToStr(he)+'h '+intToStr(mi)+'min'; end else
          if mi<>0 then begin s:=s+intToStr(mi)+'min '+intToStr(se)+'sec'; end else
          if se<>0 then begin s:=s+intToStr(se)+'sec '+intToStr(ms)+'ms'; end
          else s:=intToStr(ms)+'ms';
          Cadran.caption:=s;
end;
 
// ---- Combinaisons : ---------------------------------------------------------
// Approche A : avec affichage direct dans RichEdit ---------------------------
 
// 1ère Méthode : Par rotations successives vers la gauche.
 
var Chrono1A : oChrono;
procedure combinaison1A(st, tete: string);
var i: integer; tete_local, reste_local: string;
begin
  if length(st) = 1 then Form1.red1.lines.add(tete + st)
  else
    for i := 1 to length(st) do
    begin
      tete_local := st[1];
      reste_local := copy(st, 2, length(st) - 1);
      combinaison1A(reste_local, tete + tete_local);
      st := reste_local + tete_local;
    end;
end;
 
var Chrono2A : oChrono;
procedure combinaison2A(st, tete: string); // déclinée à partir de combinaison1
var       i: integer;
begin     if length(st) = 1 then Form1.red1.lines.add(tete + st)
          else for i := 1 to length(st) do
               begin combinaison2A(copy(st, 2, length(st) - 1), tete + st[1]);
                     st := copy(st, 2, length(st) - 1) + st[1];
               end;
end;
 
// 2ème Méthode : --------------------------------------------------------------
// on prend un mot et on permute sa première lettre avec chacune des autres lettres.
// Ensuite pour chacun des nouveaux mots obtenus, on ne touche pas à la première
// lettre et à partir de la deuxième lettre on refait les permutations entre la deuxième
// lettre et toutes les autres lettres jusqu'à la fin; ensuite pour chacun des nouveaux
// mots obtenus, on ne touche pas à la deuxième lettre et à partir de la troisième
// lettre on refait les permutations entre la troisième lettre et toutes les autres
// lettres jusqu'à la fin; on voit donc la récursivité :
 
var Chrono0A : oChrono;
procedure combinaisonsA(ch : string);
var l: byte;
 
  procedure EchangeCar(var ch: string; i, j: byte);
  var car: char;
  begin
    if i <> j then
    begin
      car := ch[i];
      ch[i] := ch[j];
      ch[j] := car;
    end
  end;
 
  procedure anagram(ch: string; i: byte);
  var j: byte;
  begin
    if i = l then Form1.red1.lines.add(ch)
    else
      for j := i to l do
      begin
        EchangeCar(ch, i, j);
        Anagram(ch, i + 1);
        EchangeCar(ch, i, j);
      end;
  end;
 
begin
  l := length(ch);
  anagram(ch, 1);
end;
 
procedure TForm1.bCombineAClick(Sender: TObject);
begin     Chrono0A.Top(labChrono0A);
          red1.clear;
          combinaisonsA(edit1.text);
          label1.caption:=intToStr(red1.lines.count)+' anagrammes';
          Chrono0A.Mis;
end;
 
procedure TForm1.bCombine1AClick(Sender: TObject);
begin     Chrono1A.Top(labChrono1A);
          red1.clear;
          combinaison1A(edit1.text,'');
          label1.caption:=intToStr(red1.lines.count)+' anagrammes';
          Chrono1A.Mis;
end;
 
procedure TForm1.bCombine2AClick(Sender: TObject);
begin     Chrono2A.Top(labChrono2A);
          red1.clear;
          combinaison2A(edit1.text,'');
          label1.caption:=intToStr(red1.lines.count)+' anagrammes';
          Chrono2A.Mis;
end;
 
// 2ème approche : On crée d'abord les anagrammes (ici dans une StringList)
//                 et ensuite seulement on les affiche dans la RichEdit via un Stream
 
var StringList : tStringList;   // créée et libérée par routine d'appel
    Stream     : tMemoryStream; // idem
// Un 1er gain de rapidité provient du passage par la StringList
 
// 1ère Méthode : Par rotations successives vers la gauche.
var Chrono1B : oChrono;
procedure combinaison1B(st, tete: string);
var i: integer; tete_local, reste_local: string;
begin
  if length(st) = 1 then StringList.add(tete + st)
  else
    for i := 1 to length(st) do
    begin
      tete_local := st[1];
      reste_local := copy(st, 2, length(st) - 1);
      combinaison1B(reste_local, tete + tete_local);
      st := reste_local + tete_local;
    end;
end;
 
var Chrono2B : oChrono;
procedure combinaison2B(st, tete: string); // déclinée à partir de combinaison1B
var       i: integer;
begin     if length(st) = 1 then StringList.add(tete + st)
          else for i := 1 to length(st) do
               begin combinaison2B(copy(st, 2, length(st) - 1), tete + st[1]);
                     st := copy(st, 2, length(st) - 1) + st[1];
               end;
end;
 
// 2ème Méthode : --------------------------------------------------------------
var Chrono0B : oChrono;
procedure combinaisonsB(ch : string);
var l: byte;
 
  procedure EchangeCar(var ch: string; i, j: byte);
  var car: char;
  begin
    if i <> j then
    begin
      car := ch[i];
      ch[i] := ch[j];
      ch[j] := car;
    end
  end;
 
  procedure anagram(ch: string; i: byte);
  var j: byte;
  begin
    if i = l then StringList.add(ch)
    else
      for j := i to l do
      begin
        EchangeCar(ch, i, j);
        Anagram(ch, i + 1);
        EchangeCar(ch, i, j);
      end;
  end;
 
begin
  l := length(ch);
  anagram(ch, 1);
end;
 
procedure TForm1.bCombineBClick(Sender: TObject);
begin     Chrono0B.Top(labChrono0B);
          StringList:=tStringList.create;
          Stream:=tMemoryStream.create;
          red1.clear;
          combinaisonsB(edit1.text);
          label1.caption:=intToStr(StringList.count)+' anagrammes';
          StringList.SaveToStream(Stream);
          Stream.Position:=0;
          red1.Lines.LoadFromStream(Stream); // X fois plus rapide que red1.lines.Assign(StringList);
          StringList.free;
          Stream.free;
          Chrono0B.Mis;
 
end;
 
procedure TForm1.bCombine1BClick(Sender: TObject);
begin     Chrono1B.Top(labChrono1B);
          StringList:=tStringList.create;
          Stream:=tMemoryStream.create;
          red1.clear;
          combinaison1B(edit1.text,'');
          label1.caption:=intToStr(StringList.count)+' anagrammes';
          StringList.SaveToStream(Stream);
          Stream.Position:=0;
          red1.Lines.LoadFromStream(Stream);
          StringList.free;
          Stream.free;
          Chrono1B.Mis;
end;
 
procedure TForm1.bCombine2BClick(Sender: TObject);
begin     Chrono2B.Top(labChrono2B);
          StringList:=tStringList.create;
          Stream:=tMemoryStream.create;
          red1.clear;
          combinaison2B(edit1.text,'');
          label1.caption:=intToStr(StringList.count)+' anagrammes';
          StringList.SaveToStream(Stream);
          Stream.Position:=0;
          red1.Lines.LoadFromStream(Stream);
          StringList.free;
          Stream.free;
          Chrono2B.Mis;
end;
 
end. //-------------------------------------------------------------------------
 
Résultats comparatifs des tests de vitesse et conclusion :
 
1er exemple : Pour les 5040 anagrammes de 'ABCDEFG' soit 7 char :
 
- Approche A : avec affichage direct dans RichEdit = avec routines combinaisonsA(),
  combinaison1A, combinaison2A : mis en moyenne 6sec 434 ms.
- Approche B : avec affichage différé via StringList et Stream = avec routines combinaisonsB(),
  combinaison1B, combinaison2B : mis en moyenne 83 ms, soit environ 77,5 fois plus rapide.
 
2ème exemple : Pour les 40320 anagrammes de 'ABCDEFGH' soit 8 char
 
- Approche A : mis 7min 14sec !!! (avec routine combinaisonsA)
- Approche B : mis en moyenne 628 ms soit environ 691 fois plus rapide.
 
Autre constat : Pour les 362880 anagrammes de 'ABCDEFGHJ' soit 9 char :
ma bécane tousse 'Mémoire insuffisante' même en fermant toutes les applis.
 
Améliorations à envisager : En conséquence vaut mieux envoyer les string directement dans un TfileStream
plutôt que via la StringList et le MemoryStream (qui actuellement sont simultanément
en mémoire) et de n''afficher dans la RichEdit qu''une fraction.

[sjrd]

Ben en fait, Gilbert, si tu relis le premier message, on ne cherche pas les anagrammes, ici On cherche toutes les combinaisons de mots formés de x caractères, chacun pris dans un ensemble donné.

En effet on peut avoir 'aaa', 'aab', etc.

Donc ça prend beaucoup plus de temps. Des anagrammes c'est x!, mais des combinaisons comme ça c'est x^y, où y est le nombre de caractères possibles. Alors je vais parler comme si effectivement il s'agissait d'un brute-force, vous m'en voulez pas, hein ?

Déjà moi une fois j'ai essayé un pseudo brute-force de mot de passe à 8 caractères, pris dans [0-9A-Za-z], pour voir la qualité de sécurité qu'offraient les mots de passe utilisateur de Linux. Ce qui me faisait donc 62^8 ~= 2,18 x 10^14. Et après avoir lancé 3 machines pendant 5 heures, mes estimations étaient qu'avec 1000 ordinateurs, j'en aurais pour 10 jours. Encore faut-il avoir les 1000 ordinateurs Et c'était en C, sans aucune réallocation mémoire !

Lui il en a pour 36^20 possibilités, soit environ 1,34 x 10^31 ! 10^17 fois plus !

C'est pas pour rien que les serials sont si longs : à moins de contrôler tous les ordinateurs de la Terre, dur dur de les brute-forcer

[Gilbert Geyer]

En fait sachant par avance que de sortir, ne serai-ce que les combinaisons sans répétition de n charactères distincts pris p à p, et que le message initial donne de plus un nombre de caractères n = 33, j'étais persuadé qu'il serait impossible de les sortir tous sur un ordinateur individuel et à plus forte raison si on vise un niveau d'exigence supérieur (caractères non distincts, majuscules/minuscules, ...).
En conséquece de quoi je m'étais dit que pour simplifier la vie à BATiViR il pourrait éventuellement se contenter des anagrammes (ce dépend bien sûr de l'objectif visé).
Il y a toutefois un truc qui m'intrigue dans la demande initiale : on part d'une série formée par les 10 chiffres de base et 23 caractères majuscules allant (seulement) de A à W et comme il manque X, Y et Z qui sont également utilisables pour créer des mots de passe je me demande à quoi cela va servir (?).

J'ajoute à ceci que dans le sujet global des "longues boucles" il y a également un thème très intéressant c'est celui de l'optimisation du code pour les gains de vitesse et de mémoire.

Ce qui est rassurant dans ton message c'est "à moins de contrôler tous les ordinateurs de la Terre, dur dur de les brute-forcer" ... cela protègera au moins des sites sensibles.