program vieg;

{$APPTYPE CONSOLE}

uses
  SysUtils, Classes;


//tato funkce projede vsechny moznosti a vrati vsechny mozne klice
//(je jich stejne, jako pismen v crypted textu)
function GetKeys(plainword,crypted:string):TStrings;
var i,j:Integer;
    str:string;
    posun:shortint;
begin
 Result := TStringList.Create();

 plainword := LowerCase(plainword);
 crypted   := LowerCase(crypted);

 for i := 1 to Length(crypted) do
  begin
   str := '';
   for j := 1 to Length(plainword) do
    begin
     if (i+j > Length(crypted)) then continue;
     posun := ord(crypted[i+j-1])-97-(ord(plainword[j])-97);

     if (posun+97 < 97) then posun := posun + 26;
     if (posun+97 > 122) then posun := posun - 26;

     str := str + chr(posun+97);
    end;

   Result.Add(str);
  end;//for i

end;//function

//zjistuje opakovani znaku v danem stringu
function GetRepeat(rptcnt:integer;str:string):boolean;
var i,j:Integer;
    fchar:char;
begin
 if (Length(str) < rptcnt) then
  begin
   Result := true;
   Exit;
  end;

 for i := 0 to rptcnt-1 do
  begin
   fchar := str[i+1];
   j := i+1;
   while (j <= Length(str)) do
    begin
     if (str[j] <> fchar) then
      begin
       Result := false;
       Exit;
      end;
     j := j + rptcnt;
    end;
  end;//for i

 Result := true;
end;//function

var
 plain,crypted:string;
 i,k:Integer;
 ret,str2:TStrings;
begin
  try
    writeln('-- Desifrovator Viegenrovy sifry --');
    writeln('Zadejte slovo, ktere se ma v plainetxtu vyskytovat:');
    readln(plain);
    writeln('Zadejte zasifrovany text:');
    readln(crypted);

    ret := GetKeys(plain,crypted);
    writeln('Mozne klice:');
    for i := 0 to ret.Count-1 do
     writeln(i,': ',ret[i]);

    writeln('Mozne realne klice:');

    i := 0;
    while (i < ret.Count) do
     begin
      if (Length(ret[i]) < Length(plain)) then ret.Delete(i);
      i := i + 1;
     end;

    //filtrace vystupu pouze na ty potencialni klice, ktere maji delku plain slova
    str2 := TStringList.Create();


    for k := 2 to Length(plain) do
     begin
      writeln('Delka klice = ',k,':');
      //snazime se najit takove klice, ve kterych se opakuji znaky po lenght mistech
      for i := 0 to ret.Count-1 do
        if (GetRepeat(k,ret[i])) then writeln(i,': ',ret[i]);
     end;//for k

    str2.Free();
  except
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
end.
