Entwickler-Ecke
Algorithmen, Optimierung und Assembler - Brute-Forcing
GTA-Place - Sa 26.11.05 12:07
Titel: Brute-Forcing
Diese Funktion hab ich vor längerer Zeit mal geschrieben.
Ich glaube man könnte da noch einiges optimieren:
Delphi-Quelltext
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:
| var
BArray: Array[97..121] of String;
function GenerateWords(Last: String): String;
var
Laenge, Zahl: Integer;
Schleife, Minus: Integer;
NBuch, LBuch: String;
begin
Result := '';
Laenge := Length(Last)-1;
LBuch := Copy(Last, Laenge+1, 1);
Zahl := 0;
Minus := 1;
for Schleife := 97 to 121 do
begin
if BArray[Schleife] = LBuch then
begin
Zahl := Schleife;
Break;
end;
end;
if (Zahl = 0) AND (Copy(Last, 1, 1) <> 'z') then
begin
LBuch := Copy(Last, Laenge, 1);
for Schleife := 97 to 121 do
begin
if BArray[Schleife] = LBuch then
begin
Zahl := Schleife;
Break;
end;
end;
while Zahl = 0 do
begin
LBuch := Copy(Last, Laenge-Minus, 1);
for Schleife := 97 to 121 do
begin
if BArray[Schleife] = LBuch then
begin
Zahl := Schleife;
Break;
end;
end;
inc(Minus);
end;
NBuch := Chr(Zahl+1);
for Schleife := 1 to Minus do
NBuch := NBuch + 'a';
Result := Copy(Last, 0, Laenge-Minus) + NBuch;
end
else
begin
NBuch := Chr(Zahl+1);
if (Copy(Last, 0, 1) = 'z') AND (Zahl = 0) then
begin
NBuch := 'a';
for Schleife := 1 to Laenge+1 do
NBuch := NBuch + 'a';
Result := NBuch;
end
else
Result := Copy(Last, 0, Laenge) + NBuch;
end;
end; |
Außerdem wäre es gut, wenn es noch eine Möglichkeit für einen Start/End-Buchstaben gibt.
Sprich: Es sollen nur Wörter generiert werden die mit V anfangen und vielleicht mit L enden.
Eine weitere Möglichkeit wäre dann nur Wörter zu generieren, die es geben kann.
Sprich: Vermeiden von Vv oder Xz.
Was würdet ihr an der Funktion anders machen? Ich denk die muss vielleicht komplett neu
aufgebaut werden, da sie so auch ziemlich unübersichtlich ist. Ich hab ne Weile gebraucht
um alle Fehler rauszubekommen, weil man ja nicht gleich weiß wo der Fehler ist.
Man könnte ja gleich ein Array mit den Buchstaben von A - Z erstellen. So muss nicht immer
Chr() aufgerufen werden, was vielleicht Zeit kostet und woran wieder die Übersichtlichkeit leidet.
Muffin - Sa 26.11.05 12:54
Die Funktion GetTickCount gibt die Zeit in Milisekunden an, die seit dem Start des Betriebssystems verstrichen sind. Damit kannst du recht einfach die Zeit messen, die dein Algorithmus braucht, und auch gleich die Optimierungserfolge sehen. Finde ich immer sehr motivierend :)
GTA-Place - Sa 26.11.05 13:02
Ja, verwende ich auch öfters.
In dem Fall braucht die Funktion für 26*26*26 Buchstaben: 16.062 Millisekunden.
Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
| Start := GetTickCount;
while LaengeW <= BLaengeW do
begin
if Stop = True then
begin
Stop := False;
Exit;
end;
Antwort := RandomPassword(Memo1.Lines[Memo1.Lines.Count-1]);
LaengeW := Length(Antwort);
Memo1.Lines.Add(Antwort);
Buchstaben := Buchstaben+1;
end;
ShowMessage(FloatToStr(GetTickCount - Start)); |
GTA-Place - Sa 26.11.05 19:08
Hab mal ne viel kürzere Funktion (Procdeure) geschrieben:
Delphi-Quelltext
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:
| var
LArray: Array[1..26] of Char;
WordArray: Array of Integer;
procedure TForm1.FormCreate(Sender: TObject);
var
X: Integer;
begin
for X := 97 to 121 do
LArray[X] := Chr(X);
end;
procedure GenerateWords2;
var
X: Integer;
begin
if WordArray[Length(WordArray) - 1] + 1 = 27 then
begin
WordArray[Length(WordArray) - 1] := 1;
for X := Length(WordArray) - 2 downto 0 do
begin
WordArray[X] := 1;
inc(WordArray[X - 1]);
try
if not (WordArray[X - 1] = 27) then
Break;
except
Break;
end;
end;
end
else
inc(WordArray[Length(WordArray) - 1]);
end;
procedure TForm1.Button3Click(Sender: TObject);
var
X, Y: Integer;
StartL: Integer;
LaengeW: Integer;
EndL: Integer;
TempStr: String;
Start: Single;
begin
Memo1.Clear;
Stop := False;
StartL := 1;
EndL := 1;
LaengeW := StrToInt(VonEdit.Text);
SetLength(WordArray, LaengeW);
for X := 0 to LaengeW - 1 do
begin
WordArray[X] := 1; LaengeW := StartL * 26;
end;
for X := 1 to StrToInt(BisEdit.Text) do
EndL := EndL * 26;
Start := GetTickCount;
for X := StartL to EndL do
begin
if Stop = True then
begin
Stop := False;
Exit;
end;
GenerateWords2;
LaengeW := Length(WordArray);
TempStr := '';
for Y := 0 to Length(WordArray) - 1 do
TempStr := TempStr + LArray[WordArray[Y]];
Application.ProcessMessages;
Memo1.Lines.Add(TempStr);
end;
ShowMessage('Dauer: ' + FloatToStr(GetTickCount - Start));
end; |
Da muss aber irgendwo ein Fehler sein, denn 1. steht nie was im Memo
und 2. Ist WordArray[Y] beim 2. Mal viel zu groß (über 100.000).
F34r0fTh3D4rk - Sa 26.11.05 20:36
guck dir doch meinen namegen an, der src schwirrt hier bestimmt rum, vielleicht nicht der aktuellste aber besser als garnischt ;)
GTA-Place - Sa 26.11.05 20:41
OK, guck's mir mal an. Würde aber trotzdem gern wissen wo der Fehler ist.
Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!