(***********************************************************
*                                                          *
*  DCV na PGM                                              *
*                                                          *
*  Autor: Jan Pacner                                       *
*                                                          *
*  Zadani:                                                 *
*    polyalfabeticka sifra:                                *
*    zadame sifrovaci klic                                 *
*      (jakekoliv abecedni znaky)                          *
*    zadame text k posunuti                                *
*    program vypise zasifrovany text,                      *
*    pote se zepta, jestli chceme zasifrovanou vetu        *
*    odsifrovat, kdyz ano, zepta se na sifrovaci klic,     *
*    kdyz nebudeme chtit odsifrovavat, zepta se jestli     *
*    chceme skoncit nebo znovu cele od zacatku             *
*                                                          *
*  made 7.3.2008 and last modified 15.3.2008 14:25         *
*                                                          *
***********************************************************)

program polyalfabeticka_sifra;

var
input,output,keyin,keyout,odsifrovat,exit:string[99];
pozice:integer;
i,y:byte;

begin

writeln ('tento program umi sifrovat polyalfabetickym sifrovanim',chr(10));

repeat


    (***  KLIC  ***)

writeln ('-!- napiste sifrovaci klic - slovo');
readln (keyin);

// prevedeme VELKA pismena v klici na mala (pokud se tam vyskytuji):

keyout:=('');
for i:=1 to length(keyin) do begin
  if (keyin[i] in ['A'..'Z']) then
    pozice:=97+(ord(keyin[i])-ord('A'))
    else pozice:=ord(keyin[i]);
  keyout:=concat(keyout,chr(pozice));
end;


    (*** ZASIFROVANI - VETA 4.POKUS ***)

writeln ('-!- zadejte vetu, ktera ma byt zasifrovana:');
readln (input);
output:=('');

for i:=1 to length(input) do begin

if i>length(keyout) then begin
  if (i mod length(keyout))=0 then y:=length(keyout)
    else y:=(i mod length(keyout));
end
  else y:=i;

if (input[i] in ['A'..'Z']) or (input[i] in ['a'..'z']) then begin
  if (input[i] in ['A'..'Z']) and (keyout[y] in ['a'..'z']) then begin
    pozice:=ord(input[i])-ord('A')+ord(keyout[y])+1;
//          (posun               )+klic         +1
    if not(pozice in [65..90]) then begin
      pozice:=65+((pozice-90) mod 26)-1;
      if pozice<65 then pozice:=90-(65-pozice)+1;
    end;
  end
    else
      if (input[i] in ['a'..'z']) and (keyout[y] in ['a'..'z']) then begin
        pozice:=ord(input[i])-ord('a')+ord(keyout[y])+1;
        if not(pozice in [97..122]) then begin
          pozice:=97+((pozice-122) mod 26)-1;
          if pozice<97 then pozice:=122-(97-pozice)+1;
        end;
      end
        else pozice:=ord(input[i]);
end
  else pozice:=ord(input[i]);
output:=concat(output,chr(pozice));
end;

writeln ('-!- toto je zasifrovana veta:');
writeln (output);


    (***  KLIC  ***)

writeln (chr(10),'-!- chcete zasifrovanou vetu zase odsifrovat? (y/n):');
repeat
  readln (odsifrovat);
  if (odsifrovat<>('y')) and (odsifrovat<>('n'))
    then writeln ('-!- neodpovedela jste "y" nebo "n"',chr(10),'zkuste to znovu:');
until (odsifrovat=('y')) or (odsifrovat=('n'));

if odsifrovat=('y') then begin

writeln (chr(10),'-!- rozsifrovani ZASIFROVANE vety:');
writeln ('-!- napiste sifrovaci klic - slovo');
readln (keyin);

// prevedeme VELKA pismena v klici na mala (pokud se tam vyskytuji):

keyout:=('');
for i:=1 to length(keyin) do begin
  if (keyin[i] in ['A'..'Z']) then
    pozice:=97+(ord(keyin[i])-ord('A'))
    else pozice:=ord(keyin[i]);
  keyout:=concat(keyout,chr(pozice));
end;


    (***  ROZSIFROVANI  ***)

    (***  start  ***)

input:=output;
output:=('');

for i:=1 to length(input) do begin

if i>length(keyout) then begin
  if (i mod length(keyout))=0 then y:=length(keyout)
    else y:=(i mod length(keyout));
end
  else y:=i;

if (input[i] in ['A'..'Z']) or (input[i] in ['a'..'z']) then begin
  if (input[i] in ['A'..'Z']) and (keyout[y] in ['a'..'z']) then begin
    pozice:=ord(input[i])-(ord(keyout[y])-(ord('A')))-1;
//          ( vysledek  )-(  klic = posun          )-1
    if not(pozice in [65..90]) then begin
      pozice:=90-((65-pozice) mod 26)+1;
      if pozice<65 then pozice:=90-(65-pozice)+1;
    end;
  end
    else
      if (input[i] in ['a'..'z']) and (keyout[y] in ['a'..'z']) then begin
        pozice:=ord(input[i])-(ord(keyout[y])-(ord('a')))-1;
        if not(pozice in [97..122]) then begin
          pozice:=122-((97-pozice) mod 26)+1;
          if pozice<97 then pozice:=122-(97-pozice)+1;
        end;
      end
        else pozice:=ord(input[i]);
end
  else pozice:=ord(input[i]);
output:=concat(output,chr(pozice));
end;

writeln ('-!- toto je rozsifrovana veta:');
writeln (output);
end
else exit:=('y');

    (***  end  ***)


writeln (chr(10),'-!- chcete ukoncit program (y/n)');
//writeln ('-!- (y - ukoncit; n - dam si to cele znovu :-D)');
repeat
  readln (exit);
  if (exit<>('y')) and (exit<>('n')) then begin
    writeln ('-!- napsali jste neco jineho nez "y" nebo "n"');
    writeln ('-!- zkuste to znovu:');
    end;
until (exit=('y')) or (exit=('n'));

until (exit=('y'));

writeln (chr(10),'this program was made by Globator007 and');
writeln ('is licenced under GNU-GPLv3 or higher');
writeln ('for exit press Enter');
readln;
end.
„Vhodnou základnou pro manželství je oboustranné nepochopení.“ Oscar Wilde