Dze je subor www.TrSek.com/cover/andrew/cryptor.pas{ 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.