{ CRYPTOR.PAS } { Program koduje klasicke TXT subory do velkosti 62,5kB Caesarovou } { metodou,+ pre vacsiu ochranu si ziada aj ciselny kod } { pre kodovanie/odkodovanie. } { } { Author: Andrew DiE } { Datum: 21.08.2005 http://www.trsek.com } program Cryptor_3_Caesar_crypting_technology; uses crt; var inf : string; var i,j, opt : longint; var F: Text; var Ch: array[0..64000] of char; var passw: shortint; {A-#65 Z-#90 a-#97 z-#122} var y:longint; procedure encrypt(var aa:char); begin case aa of #65..#89 : begin y:=ord(aa); y:=y+1; aa:=chr(y); end; #90 : aa:=#65; #97..#121 : begin y:=ord(aa); y:=y+1; aa:=chr(y); end; #122 : aa:=#97; end; end; procedure decrypt(var aa:char); begin case aa of #66..#90 : begin y:=ord(aa); y:=y-1; aa:=chr(y); end; #65 : aa:=#90; #98..#122 : begin y:=ord(aa); y:=y-1; aa:=chr(y); end; #97 : aa:=#122; end; end; procedure vystup(i:longint); var x:integer; begin Assign(F, inf); Rewrite(F); for x:=0 to i do Write(F, Ch[x]); Close(F); end; procedure vstup_e; begin Assign(input, inf); Reset(input); i:=0; while not Eof(input) do begin Read(input, Ch[i]); encrypt(ch[i]); i:=i+1; end; end; procedure vstup_d; begin Assign(input, inf); Reset(input); i:=0; while not Eof(input) do begin Read(input, Ch[i]); decrypt(ch[i]); i:=i+1; end; end; begin clrscr; textcolor(LightRed);write('WARNING!!! '); textcolor(white);writeln('Autor tohto programu nezodpoveda za pripadne skody sposobene'); writeln(' chybou kryptovania (napr. straty casti textu),'); writeln(' pouzitie na vlastne riziko!'); readln; clrscr; writeln('1.Encrypt'); writeln('2.Decrypt'); readln(opt); writeln; case opt of 1 : write('Vytvor ciselny kod pre lepsiu ochranu (1..11) : '); 2 : write('Zadaj ciselny kod protrebny na odkodovanie (1..11) : '); end; readln(passw); if (passw<1) or (passw>11) then exit; clrscr; write('Absulutna cesta k TXT suboru : ');read(inf); for j:=1 to passw do case opt of 1 : begin vstup_e; vystup(i-1); {exit;} end; 2 : begin vstup_d; vystup(i-1); {exit;} end; end; if opt=1 then begin clrscr; write('Ciselny kod ktory je treba zadat pri odkodovani je : '); textcolor(lightgray);writeln(passw); textcolor(white);writeln; writeln('Press any key to continue....'); readkey; end; end.