(*Encypter 2000 Text Encyption by Roger Brooks M4
V1.0 Can be freely distrubuted but without any
changes to the source code*)

Program encypt2000;

Uses crt;

Var
  selection : Integer;

Procedure invaildentry;
Begin
  WriteLn ('Error');
  WriteLn ('Invaild Entry');
  WriteLn ('');
End;

Procedure encypt;
Const
  key = 122;

Var
  intext, outext : Text;
  CH, outputch, pwch, endpwchar : Char;
  pw, outextname, intextname : String;
  outputnum, pwchnum : Integer;
  
Begin
  ClrScr;
  WriteLn ('');
  WriteLn ('Enter the full path and filename of the file to be encypted.');
  ReadLn (intextname);
  WriteLn ('');
  WriteLn ('Enter the full path and filename of the output file.');
  ReadLn (outextname);
  WriteLn ('');
  WriteLn ('Enter the password for the new encrypted file ', outextname, '.');
  ReadLn (pw);
  WriteLn ('');
  pw := pw + endpwchar;
  WriteLn ('Encypting Please Wait.');
  Assign (intext, intextname);
  Assign (outext, outextname);
  Reset (intext);
  Rewrite (outext);
  While Not pwchnum = 6577 Do
  Begin
    Read (pw, pwch);
    pwchnum := Ord (pwch) + key;
    pwch := Char (pwchnum);
    Write (outext, pwch);
  End;
  While Not EoF (intext) Do
  Begin
    Read (intext, CH);
    outputnum := Ord (CH) + key;
    outputch := Char (outputnum);
    Write (outext, outputch);
  End;
  WriteLn ('Success!');
  Close (intext);
  Close (outext);
End;

Procedure decypt;
Const
  key = 122;
  
Var
  filepath, pw, outfilepath  : String;
  CH, filepwchr, pwchr : Char;
  outputnum, pwchrnum, filepwchrnum, chnum : Integer;
  infile, Output : Text;
  
Begin
  ClrScr;
  WriteLn ('');
  WriteLn ('Enter the name and the path of the file you would like to decrypt.');
  WriteLn ('');
  ReadLn (filepath);
  WriteLn ('Enter the name and path of the decrypted file.');
  WriteLn ('');
  ReadLn (outfilepath);
  WriteLn ('Enter the password for the encypted file ', filepath, '.');
  WriteLn ('');
  ReadLn (pw);
  WriteLn ('');
  WriteLn ('Dectypting file Please Wait....');
  WriteLn ('');
  Assign (infile, filepath);
  Assign (Output, outfilepath);
  Reset (infile);
  Rewrite (Output);
  While Not pwchrnum = 6565 Do
  Begin
    Read (infile, filepwchr);
    filepwchrnum := Ord (filepwchr) - key;
    Read (pw, pwchr);
    pwchrnum := Ord (pwchr);
    If Not pwchrnum = filepwchrnum Then Exit;
  End;
  WriteLn (Output, '');
  While Not EoF (infile) Do
  Begin
    Read (infile, CH);
    outputnum := Ord (CH) - key;
    CH := Char (outputnum);
    Write (Output, CH);
  End;
  WriteLn ('');
  WriteLn ('Success!');
  Close (infile);
  Close (Output);
End;

Begin
  ClrScr;
  WriteLn ('Welcome to Text Encyption 2000 V1.0 by Roger Brooks');
  WriteLn ('This code may be freely distrubuted without any changes made to it');
  WriteLn ('If you have any questions, comments, or want source code');
  WriteLn ('E-Mail me at rogerab@onebox.com');
  WriteLn ('');
  WriteLn ('To encypte a file press 1');
  WriteLn ('To decypte a file press 2');
  WriteLn ('');
  Write ('Enter selection: ');
  ReadLn (selection);
  WriteLn ('');
  If selection = 1 Then
    encypt
  Else
    If selection = 2 Then
      decypt
    Else
      invaildentry;
End.

