this slowpoke moves

Multi Thread Brute Force Algorithm

Unit UnitThreadBruteForce.pas
unit UnitThreadBruteForce;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls, ComCtrls, Math;

type
  TThreadBruteForce = class(TThread)
  Numero: SmallInt;
  BeginAt, LastOne: Extended;
  LaChaine, Progression: ShortString;
  Procedure BruteForce(Caracteres: ShortString; NbCarMax, NbCarBegin: SmallInt; StartFrom: ShortString);
  private
    { Private declarations }
  protected
    procedure Execute; override;
    procedure UpdateCaption;
  end;

implementation

uses Menu;

Procedure TThreadBruteForce.BruteForce(Caracteres: ShortString; NbCarMax, NbCarBegin: SmallInt; StartFrom: ShortString);
Var I: Integer;
    Chaine: Array of Char;
    StrChaine: ShortString;
    NumeroPossibility, NbPossibilities: Extended;
begin
        NbPossibilities:=LastOne-BeginAt+1;
        NumeroPossibility:=0;
        SetLength(Chaine, NbCarMax);
        For I:=0 To NbCarMax-1 do
        begin
                If (Length(StartFrom)>0) and (I>=NbCarMax-Length(StartFrom)) Then
                        Chaine[I]:=StartFrom[I-(NbCarMax-Length(StartFrom)-1)]
                else begin
                        If I>=NbCarMax-NbCarBegin Then
                                Chaine[I]:=Caracteres[1]
                                else
                                Chaine[I]:=Chr(0);
                end;
        end;

        While NumeroPossibility<NbPossibilities do
        begin
                NumeroPossibility:=NumeroPossibility+1;
                For I:=0 To NbcarMax-1 do
                        If Chaine[I]<>chr(0) Then StrChaine:=StrChaine+Chaine[I];

                LaChaine:=StrChaine;
                Progression:=FloatToStr(NumeroPossibility) + '/' + FloatToStr(NbPossibilities);
                Synchronize(UpdateCaption);
                StrChaine:='';
                For I:=NbcarMax-1 downto 0 do
                begin
                        If Pos(Chaine[I], Caracteres)<Length(Caracteres) Then
                        begin
                                Chaine[I]:=Caracteres[Pos(Chaine[I], Caracteres)+1];
                                Break;
                        end else begin
                                Chaine[I]:=Caracteres[1];
                        end;
                end;
                Application.ProcessMessages;
        end;
end;

procedure TThreadBruteForce.Execute;
Var I, NbCar: Integer;
    NbPossibilities, Compte: Extended;
    TheFirstWord: String;
    TabCar: Array of Integer;
begin
        If (Numero=1) and (Form1.EditChaineReprise.Text<>'') Then
                TheFirstWord:=Form1.EditChaineReprise.Text
        else begin
                NbPossibilities:=0;
                For I:=StrToInt(Form1.Edit2.Text) To StrToInt(Form1.Edit1.Text) do
                begin
                        NbPossibilities:=NbPossibilities + Power(Length(Form1.EditCarUtil.Text),I);
                        If NbPossibilities>=BeginAt Then Break;
                end;
                NbCar:=I;
                Compte:=0;
                SetLength(TabCar, NbCar);
                For I:=0 To Length(TabCar)-1 do
                        TabCar[I]:=Length(Form1.EditCarUtil.Text);
                For I:=NbCar DownTo 1 do
                begin
                        While Compte+TabCar[I-1]*Power(Length(Form1.EditCarUtil.Text), I-1)>BeginAt do
                                TabCar[I-1]:=TabCar[I-1]-1;
                        Compte:=Compte+TabCar[I-1]*Power(Length(Form1.EditCarUtil.Text), I-1);
                end;
                TheFirstWord:='';
                For I:=NbCar-1 DownTo 0 do
                        TheFirstWord:=TheFirstWord+Form1.EditCarUtil.Text[TabCar[I]];
        end;

        BruteForce(Form1.EditCarUtil.Text, StrToInt(Form1.Edit1.Text), StrToInt(Form1.Edit2.Text), TheFirstWord);
end;

procedure TThreadBruteForce.UpdateCaption;
Var Item: TListItem;
begin
        Application.processMessages;
        Item:=Form1.ListView1.Items.Item[Numero-1];
        Item.SubItems.Strings[0]:=LaChaine;
        Item.SubItems.Strings[1]:=Progression;
end;

end.
Unit1 :
uses ExtCtrls, ComCtrls, UnitThreadBruteForce, Math

type TBruteForce=record
        Number: Integer;
        Chaine, Progress : ShortString;
        Percent,Debit: Real48;
        TempsRestant: ShortString;
end;

public
    { Public declarations }
    Procedure Sleep(Delai: Double);
    Procedure BruteForce(Caracteres: ShortString; NbCarMax, NbCarBegin:
              SmallInt; StartFrom: ShortString; LeCaption: TStrings);
  end;

var
  Form1: TForm1;
  TabThread: Array of TThreadBruteForce;
  TabProgression: Array of Single;
  StopSimpleBruteForce, PauseSimpleBruteForce: Boolean;

//

Procedure TForm1.Sleep(Delai: Double);
Var HeureDepart: TDateTime;
begin
        HeureDepart:=now;
        Delai:=delai/24/60/60/1000;
        repeat
                Application.ProcessMessages;
        Until Now>HeureDepart+Delai;
end;

Procedure TForm1.BruteForce(Caracteres: ShortString; NbCarMax, NbCarBegin: SmallInt; StartFrom: ShortString; LeCaption: TStrings);
Var I: Integer;
    Chaine: Array of Char;
    StrChaine: ShortString;
    NumeroPossibility, NbPossibilities: Extended;
begin
        NbPossibilities:=0;
        For I:=NbCarBegin To NbCarMax do
                NbPossibilities:=NbPossibilities+Power(Length(Caracteres), I);
        NumeroPossibility:=0;
        For I:=1 To Length(StartFrom) do
                NumeroPossibility:=NumeroPossibility + (Pos(StartFrom[I], Caracteres)-1) * Power(Length(Caracteres), Length(StartFrom)-I );
        For I:=1 To Length(StartFrom)-1 do
                NumeroPossibility:=NumeroPossibility + Power(Length(Caracteres), I);
        SetLength(Chaine, NbCarMax);
        For I:=0 To NbCarMax-1 do
        begin
                If (Length(StartFrom)>0) and (I>=NbCarMax-Length(StartFrom)) Then
                        Chaine[I]:=StartFrom[I-(NbCarMax-Length(StartFrom)-1)]
                else begin
                        If I>=NbCarMax-NbCarBegin Then
                                Chaine[I]:=Caracteres[1]
                                else
                                Chaine[I]:=Chr(0);
                end;
        end;

        While (NumeroPossibility<NbPossibilities) and (StopSimpleBruteForce=False) do
        begin
                While PauseSimpleBruteForce=True do
                        Sleep(1000);

                NumeroPossibility:=NumeroPossibility+1;

                For I:=0 To NbcarMax-1 do
                        If Chaine[I]<>chr(0) Then StrChaine:=StrChaine+Chaine[I];
                LeCaption[0]:=StrChaine;
                LeCaption[1]:=FloatToStr(NumeroPossibility) + '/' + FloatToStr(NbPossibilities);

                StrChaine:='';
                For I:=NbcarMax-1 downto 0 do
                begin
                        If Pos(Chaine[I], Caracteres)<Length(Caracteres) Then
                        begin
                                Chaine[I]:=Caracteres[Pos(Chaine[I], Caracteres)+1];
                                Break;
                        end else begin
                                Chaine[I]:=Caracteres[1];
                        end;
                end;
                Application.ProcessMessages;
        end;
end;

Procedure TForm1.AffichCarWithCheckBox(Sender: TObject);
Var I: Byte;
begin
        EditCarUtil.Text:='';
        If CheckBox4.Checked=True Then
        begin
                For I:=1 to 255 do
                        EditCarUtil.Text:=EditCarUtil.Text+Chr(I);
                CheckBox1.Checked:=True;
                CheckBox2.Checked:=True;
                CheckBox3.Checked:=True;
                Exit;
        end;
        If CheckBox1.Checked=True Then
                EditCarUtil.Text:=EditCarUtil.Text+'abcdefghijklmnopqrstuvwxyz';
        If CheckBox2.Checked=True Then
                EditCarUtil.Text:=EditCarUtil.Text+'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
        If CheckBox3.Checked=True Then
                EditCarUtil.Text:=EditCarUtil.Text+'0123456789';
end;

procedure TForm1.EditCarUtilKeyPress(Sender: TObject; var Key: Char);
begin
        If Ord(Key)=8 Then Exit;
        If Pos(Key, (Sender as TEdit).Text)>0 Then Key:=chr(0);
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
        If Ord(Key)=8 Then Exit;
        If Pos(Key, '0123456789')=0 Then Key:=chr(0);
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
        If Length((Sender as TEdit).Text)=0 Then
        begin
                (Sender as TEdit).Text:='0';
                (Sender as TEdit).SelStart:=Length((Sender as TEdit).Text);
        end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
Var I: Integer;
    Item: TListItem;
    Temps: Int64;
    Heures, Minutes, Secondes: String;
    NbEnd: Integer;
begin
        NbEnd:=0;
        For I:=0 To ListView1.Items.Count-1 do
        begin
                Item:=ListView1.Items.Item[I];
                If Item.SubItems.Strings[1]<>'0/0' Then
                begin
                        If Copy(Item.SubItems.Strings[1], 1, Pos('/', Item.SubItems.Strings[1])-1)=Copy(Item.SubItems.Strings[1], Pos('/', Item.SubItems.Strings[1])+1, Length(Item.SubItems.Strings[1])-Pos('/', Item.SubItems.Strings[1])) Then
                                Inc(NbEnd);

                        Item.SubItems.Strings[2]:=FloatToStr(  StrToInt64( Copy(Item.SubItems.Strings[1], 1, Pos('/', Item.SubItems.Strings[1])-1) ) * 100 * 100 div StrToInt64( Copy(Item.SubItems.Strings[1], Pos('/', Item.SubItems.Strings[1])+1, Length(Item.SubItems.Strings[1])-Pos('/', Item.SubItems.Strings[1]))  )/100) + ' %';
                        Item.SubItems.Strings[3]:=FloatToStr(   Round(( StrToInt64( Copy(Item.SubItems.Strings[1], 1, Pos('/', Item.SubItems.Strings[1])-1) )  -  TabProgression[I] ) / (Timer1.Interval / 1000)   *100)/100) + '/s';
                        TabProgression[I]:=StrToInt64( Copy(Item.SubItems.Strings[1], 1, Pos('/', Item.SubItems.Strings[1])-1) );
                        If StrToFloat( Copy(Item.SubItems.Strings[3], 1, Pos('/', Item.SubItems.Strings[3])-1) )>0 Then
                        begin
                                Temps:=Round(  (StrToInt64( Copy(Item.SubItems.Strings[1], Pos('/', Item.SubItems.Strings[1])+1, Length(Item.SubItems.Strings[1])-Pos('/', Item.SubItems.Strings[1])) )  -  StrToInt64( Copy(Item.SubItems.Strings[1], 1, Pos('/', Item.SubItems.Strings[1])-1) ))  /  StrToFloat( Copy(Item.SubItems.Strings[3], 1, Pos('/', Item.SubItems.Strings[3])-1) )  );
                                Heures:=IntToStr(Trunc(Temps / 60 / 60));
                                If Length(Heures)=1 Then Heures:='0' + Heures;
                                Temps:=Temps mod (60*60);
                                Minutes:=IntToStr(Trunc(Temps / 60));
                                If length(Minutes)=1 Then Minutes:='0' + Minutes;
                                Secondes:=IntToStr(Temps mod 60);
                                If length(Secondes)=1 Then Secondes:='0' + Secondes;
                                Item.SubItems.Strings[4]:=Heures + ':' + Minutes + ':' + Secondes;
                        end;
                end;
        end;
        If NbEnd=ListView1.Items.Count Then
        begin
                Timer1.Enabled:=False;
        end;
end;

// Start Brute Force
procedure TForm1.Button1Click(Sender: TObject);
Var I: Integer;
    BadCar: ShortString;
    Item: TListItem;
    NumeroPossibility, NbPossibilities, PossibilitesRestantes, DejaReparti: Extended;
begin
        If Length(EditCarUtil.Text)=0 Then
        begin
                MessageBox(Handle, 'The number of characters used must be greater than 0!!!', 'Error.', 64);
                Exit;
        end;
        If StrToInt(Edit1.Text)=0 Then
        begin
                MessageBox(Handle, 'The maximum number of characters generated must be greater than 0!!!', 'Error.', 64);
                Exit;
        end;
        If StrToInt(Edit2.Text)=0 Then
        begin
                MessageBox(Handle, 'The number of characters to start with must be greater than 0!!!', 'Erreur.', 64);
                Exit;
        end;
        If StrToInt(Edit2.Text)>StrToInt(Edit1.Text) Then
        begin
                MessageBox(Handle, 'The number of characters to start with must be less than or equal to the maximum number of characters generated!!!', 'Erreur.', 64);
                Exit;
        end;
        If EditChaineReprise.Text<>'' Then
        begin
                If Length(EditChaineReprise.Text)>StrToInt(Edit1.Text) Then
                begin
                        MessageBox(Handle, 'The number of characters in the string from which the BruteForce must be taken must be less than or equal to the maximum number of characters!!!', 'Erreur.', 64);
                        Exit;
                end;
        end;
        BadCar:='';
        For I:=1 To Length(EditChaineReprise.Text) do
        begin
                If Pos(Copy(EditChaineReprise.Text, I, 1), EditCarUtil.Text)=0 Then
                begin
                        If Pos(Copy(EditChaineReprise.Text, I, 1), BadCar)=0 Then
                                BadCar:=BadCar+Copy(EditChaineReprise.Text, I, 1);
                end;
        end;
        If BadCar<>'' Then
        begin
                If MessageBox(Handle, 'Characters not found in the characters to be used are found in the string used to resume a BruteForce...' +#13+#10+
                                      'Do you want to add missing characters to the characters to use?', 'Question.', 36)=6 Then
                begin
                        EditCarUtil.Text:=EditCarUtil.Text+BadCar;
                end else
                        Exit;
        end;
        If StrToInt(Edit3.Text)=0 Then
        begin
                MessageBox(Handle, 'The fragmentation of the research must be greater than 0!!!', 'Erreur.', 64);
                Exit;
        end;

        If StrToInt(Edit3.Text)=1 Then
        begin
                SetLength(TabProgression, 1);
                TabProgression[0]:=0;
                ListView1.Items.Clear;
                Item:=ListView1.Items.Add;
                Item.Caption:='1';
                Item.SubItems.Add('');
                Item.SubItems.Add('0/0');
                Item.SubItems.Add('0%');
                Item.SubItems.Add('0/s');
                Item.SubItems.Add('00:00:00');
                Timer1.Enabled:=True;
                StopSimpleBruteForce:=False;
                PauseSimpleBruteForce:=False;
                BruteForce(EditCarUtil.Text, StrToInt(Edit1.Text), StrToInt(Edit2.Text), EditChaineReprise.Text, Item.SubItems);
        end else begin
                ListView1.Items.Clear;
                NbPossibilities:=0;
                For I:=1 To StrToInt(Edit1.Text) do
                        NbPossibilities:=NbPossibilities+Power(Length(EditCarUtil.Text), I);
                NumeroPossibility:=0;
                For I:=1 To Length(EditChaineReprise.Text) do
                        NumeroPossibility:=NumeroPossibility + (Pos(EditChaineReprise.Text[I], EditCarUtil.Text)-1) * Power(Length(EditCarUtil.Text), Length(EditChaineReprise.Text)-I );
                For I:=1 To Length(EditChaineReprise.Text)-1 do
                        NumeroPossibility:=NumeroPossibility + Power(Length(EditCarUtil.Text), I);
                For I:=1 To StrToInt(Edit2.Text)-1 do
                        NumeroPossibility:=NumeroPossibility+Power(Length(EditCarUtil.Text), I);
                PossibilitesRestantes:=NbPossibilities-NumeroPossibility;
                DejaReparti:=0;
                If PossibilitesRestantes<StrToInt(Edit3.Text) Then
                        Edit3.Text:=FloatToStr(PossibilitesRestantes);
                For I:=1 to StrToInt(Edit3.Text) do
                begin
                        SetLength(TabProgression, I);
                        TabProgression[I-1]:=0;
                        Item:=ListView1.Items.Add;
                        Item.caption:=IntToStr(I);
                        Item.SubItems.Add('');
                        Item.SubItems.Add('0/0');
                        Item.SubItems.Add('0%');
                        Item.SubItems.Add('0/s');
                        Item.SubItems.Add('00:00:00');
                        Timer1.Enabled:=True;
                        SetLength(TabThread, I);
                        TabThread[I-1]:=TThreadBruteForce.Create(True);
                        TabThread[I-1].Numero:=I;
                        TabThread[I-1].FreeOnTerminate:=True;
                        TabThread[I-1].Priority:=tpNormal;
                        If I<StrToInt(Edit3.Text) Then
                        begin
                                TabThread[I-1].BeginAt:=NumeroPossibility+DejaReparti+1;
                                TabThread[I-1].LastOne:=NumeroPossibility+DejaReparti+Trunc(PossibilitesRestantes/StrToInt(Edit3.Text));
                                DejaReparti:=DejaReparti+Trunc(PossibilitesRestantes/StrToInt(Edit3.Text));
                        end else begin
                                TabThread[I-1].BeginAt:=NumeroPossibility+DejaReparti+1;
                                TabThread[I-1].LastOne:=NbPossibilities;
                        end;
                        TabThread[I-1].Resume; 
                end;
        end;
end;

// Stop Brute Force
procedure TForm1.Button2Click(Sender: TObject);
Var I: Integer;
begin
        StopSimpleBruteForce:=True;
        For I:=0 To Length(TabThread)-1 do
        begin
                TabThread[I].Suspend;
                TabThread[I].Destroy;
        end;
        Timer1.Enabled:=False;
end;

// Pause Brute Force
procedure TForm1.Button3Click(Sender: TObject);
Var I: Integer;
begin
        PauseSimpleBruteForce:=Not(PauseSimpleBruteForce);
        For I:=0 To Length(TabThread)-1 do
        begin
                If TabThread[I].Suspended=False Then
                        TabThread[I].Suspend
                        else
                        TabThread[I].Resume;
        end;
end;

// Terminate Brute Force
procedure TForm1.Button4Click(Sender: TObject);
begin
  If Timer1.Enabled=True Then Button2.Click;
        Application.Terminate;
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate