Threaded Brute Forcing Class

Problem/Question/Abstract:

How to create a simple brute forcing engine in a delphi class.

Answer:

{-----------------------------------------------------------------------------
Unit Name: classThreadBruteForce

Version: 1.0

Release Date: 21-Aug-2002

Compiler directives:

    TINY     - removes unnessecary error messages. test that output
               is not empty
    and
    OPTIMIZE (less information is available)

Purpose:

Description:

    A TThread which generates brute force combinations through the
    onDo event.

Notes:
    Charset contains the characters (these are sorted internally)
    onFinished event provided

    Not exactly fast but it does the job.

    Use it like this:-

    brute := TBruteThread.create(true);
    brute.charset := 'abcdefghijklmnopqrstuvwxyz';  // Chars to brute
    brute.numCharacters := 5;                       // Max chars
    brute.onDo := Form1ThreadOnDo;
    brute.resume;

Dependancies:

History:

        Copyright 2002 by Stewart Moss
        All rights reserved.
-----------------------------------------------------------------------------}

unit classBruteForce;

interface
uses classes, sysutils;

type
  TBruteThread = class(TThread)
  private
    FNumChars: Integer;
    FCharset: string;
    FonDo: TNotifyEvent;
    FonFinished: TNotifyEvent;

    CharCount: string;
    minChar: char;
    maxChar: char;
    imaxChar: integer;

    incBruteLock: boolean;
    // locks the incBrute function

    procedure init;
    function incBrute(posi: integer): integer;
    function StringBubbleSort(StrIn: string): string;

  public
{$IFNDEF OPTIMIZE}
    BruteCount: integer; // not recommended on large bruteforce,
    // use your own counter
{$ENDIF}
    BruteResult: string;

    procedure execute; override;

  published

    property onDo: TNotifyEvent read FonDo write FonDo;
    property onFinished: TNotifyEvent read FonFinished write FonFinished;

    property CharSet: string read FCharset write FCharset;
    property numCharacters: Integer read FNumChars write FNumChars;

  end;

implementation

{ TBruteThread }

procedure TBruteThread.execute;
var
  loop: integer;
  tmpstr: string;
begin
  if FNumChars <= 0 then
  begin
{$IFNDEF TINY}
    raise exception.create('invalid Numchars');
{$ENDIF}
{$IFDEF TINY}
    exit;
{$ENDIF}
  end;

  if FCharSet = '' then
  begin
{$IFNDEF TINY}
    raise exception.create('Charset is blank');
{$ENDIF}
{$IFDEF TINY}
    exit;
{$ENDIF}
  end;

  init;

  while (not terminated) do
  begin
    if incbrute(1) > FNumChars then
      break;

    loop := 0;
    bruteresult := '';
    while loop < FNumChars do
    begin
      inc(loop);
      if charcount[loop] = #0 then
        break;

      // speed optimization
      tmpstr := BruteResult;
      BruteResult := tmpstr + charcount[loop];
    end;
{$IFNDEF OPTIMIZE}
    inc(Brutecount);
{$ENDIF}

    if assigned(onDo) then
      onDo(Self);
  end;

  if assigned(onFinished) then
    onFinished(Self);
end;

{-----------------------------------------------------------------------------
  Procedure: incBrute
  Arguments: posi: integer
  Result:    integer

  Purpose: Recurive

  Description:
    This function brutes

      Copyright 2002 by Stewart Moss
      All rights reserved.
-----------------------------------------------------------------------------}

function TBruteThread.incBrute(posi: integer): integer;
var
  tmpint: integer;
  bufferpos: integer;
begin
  result := posi;
  bufferpos := pos(charcount[posi], FCharset);
  charcount[posi] := FCharset[bufferpos + 1];
  if FCharset[Bufferpos] = maxchar then
  begin
    charcount[posi] := minchar;
    tmpint := incBrute(posi + 1);
    if tmpint > FnumChars then
      result := tmpint;
  end;
end;

procedure TBruteThread.init;
var
  loop: integer;
begin
  FCharSet := StringBubbleSort(FCharset);
  minchar := FCharset[1];
  maxChar := FCharset[length(FCharset)];
  imaxchar := ord(MaxChar);
  charcount := '';
  for loop := 1 to FNumChars do
  begin
    charcount := charcount + #0;
  end;
{$IFNDEF OPTIMIZE}
  Brutecount := 0;
{$ENDIF}

end;

function TBruteThread.StringBubbleSort(StrIn: string): string;
var
  i, j: Integer;
  temp: Char;
  tmplen: integer;
begin
  tmplen := length(StrIn);
  for i := 1 to tmplen do
    for j := 1 to tmplen do
      if strIn[i] < StrIn[j] then
      begin
        temp := StrIn[i];
        StrIn[i] := StrIn[j];
        StrIn[j] := temp;
      end;
  Result := strIn;
end;

end.