{Podbor program} 
Program prog {1.3};
{$mode delphi}

uses crt,math,strings,strutils;

const 
 pass_long = 2;
 pass:string[2] = 'Ab';//'aBA';
 table_char:array[0..61] of char =
 ('A','a','B','b','C','c','D','d','E','e','F','f','G','g','H','h','I','i','J','j','K','k','L','l','M','m','N','n',
  'O','o','P','p','Q','q','R','r','S','s','T','t','U','u','V','v','W','w','X','x','Y','y','Z','z',
  '1','2','3','4','5','6','7','8','9','0');  
 special_char:array[0..11] of char = ('~','!','@','#','$','%','^','&','*','-','+','=');                
 
var
 f:text;
 
function fMatching(aPattern,aMatch:string):boolean;
 var 
  i:integer;
 begin
   if (aPattern=aMatch) then fMatching:=true else fMatching:=false;
end;  

function fReplace(c:char;s:string;index:sizeint):string;
begin
  insert(c,s,index);
  delete(s,index+1,1);
  result:=s; 
end;

function fNewString(c:char;pass_l:integer):string;
 var
  i:integer;
  sn:string;
 begin
 {initialize string}
  for i:=1 to pass_l do
     sn:=sn+c;
   result:=sn;     
end;
 
function fsymbol(table:array of char;i:integer):char;
 begin
     fsymbol:=table[i];
 end;
 
procedure podbor();
 var 
  i,j,k,step1,step2,counter:integer;
  C,cn:byte;
  S,Sn:string;
 begin
   counter:=0;
   c:=0;cn:=0; //symbol place in table
   step1:=1;step2:=1;
     assign(f,'pass.txt');
     rewrite(f);


   {first init}
   S:=fNewString(table_char[Cn],pass_long);
 
sn:=s;
repeat
    S:=fNewString(table_char[Cn],pass_long);
    Sn:=fReplace((fsymbol(table_char,Cn)),Sn,step2);
    sn:=s;
  // writeln(f,sn);
  repeat
     //  Sn:=fReplace((fsymbol(table_char,Cn)),Sn,step1);
     //  if fMatching(Sn,pass) then break;
     //  writeln(f,sn);
     repeat
       Sn:=fReplace((fsymbol(table_char,C)),Sn,step1);
       if fMatching(Sn,pass) then break;
       writeln(f,sn);
       C+=1;
       counter+=1;
     until C=sizeof(table_char);
      C:=0;
      sn:=s;
      step1+=1;
      counter+=1;
  until step1>pass_long;
    sn:=s;
 Cn+=1;
        step1:=1;
     //  Cn:=0;
       //step2+=1;
 //      counter+=1;
 //Cn+=1;
until Cn=sizeof(table_char);//step2>pass_long;



   if fMatching(Sn,pass) then writeln('password: ',Sn) else
  writeln('Sorry, password not found...');

   
 close(f);
     
    
  writeln(sizeof(table_char));

  writeln(counter);
end;
      

procedure menu;
var
 key:char;
 begin
   clrscr;
   writeln('Password cracker v0.1');
   writeln(#13#10,'Press <P> to crack password');
   writeln(#13#10,'<Esc> to exit');
     repeat
       key:=readkey;
       if (key=#80) or (key=#112) then podbor();
     until key=#27;      
   writeln(#13#10,'program is finished...');
end;

Begin
     podbor();
    //menu;
End.