(*********************************************************** * * * 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.