Program na kódovanie v pascale - využitie Caesarova šifra

{ 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.