home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / CRYP60.ZIP / CRYU.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-11-15  |  23.1 KB  |  759 lines
  1. {Start of file CryU.PAS ****************************************************}
  2.  
  3. program CryU;
  4.  
  5. uses Crt, Prompt, CryUHelp;
  6.  
  7. {***************************************************************************}
  8. {
  9.  Name  = 'CryU - A data encryption system written in Pascal, user interface';
  10.  Version = 'Version 6.00, 1992-11-15, 1400 hours';
  11.  Author  = 'Copyright (c) 1987-1992 by author: Harry J. Smith';
  12.  Address = '19628 Via Monte Dr., Saratoga, CA 95070.  All rights reserved.';
  13. }
  14. { Actual Name, Version, Author, Address maintained in CryUHelp.Pas. }
  15.  
  16. {***************************************************************************}
  17.  
  18. {This program will encipher or decipher a file of data and rewrite
  19.   it into a new file}
  20.  
  21. {$I- do our own i/o error checks}
  22. {$R- Range check Array Indexes}
  23. {$V- Allow any length Strings passed to procedures}
  24.  
  25. label Continue, Exit1;
  26.  
  27. const
  28.   LastLine   = 25;    {Used in GoToXY to go to last line of CRT, 25 for PC}
  29.   FirstCol   = 1;     {Used in GoToXY to go to first column of CRT}
  30.   BufRecSize = 16384; {Number of 1-byte records in a buffer}
  31.   BufIntSize = 8192;  {Integers in buffer, BufRecSize / 2}
  32.   BufBytSize = 16384; {Bytes in buffer, 1 * BufRecSize}
  33.   ConSize    = 18;    {Number of characters in CRY.CON file}
  34.   PoolSize   = 2048;  {Integers in random number Pool, = 2**N}
  35.   PoolMask   = 2047;  {Mask for index to random number Pool, = PoolSize - 1}
  36.   NameN      = 32;    {Max number of characters in a file name}
  37.  
  38. type
  39.   Buffer = record case Integer of  {I/O buffers}
  40.              1: (Int : packed array[1..BufIntSize] of Integer);
  41.              2: (BYT : packed array[1..BufBytSize] of Char);
  42.            end;
  43.  
  44. var
  45.   RI       : array [0..8] of Integer; {Current random Int. from 9 generators}
  46.   RS       : array [0..8] of Integer; {Initial random seeds for 9 generators}
  47.   RC       : array [0..8] of Integer; {Current value of clear continue seeds}
  48.   Pool     : array [0..PoolMask] of Integer; {Pool of random integers}
  49.   RR       : Integer;   {Random Int. running combination of RI[0] thru RI[8]}
  50.   Next     : Integer;   {Random Int. running combination of RI[0] thru RI[8]}
  51.   InName   : String[NameN];  {Input file name}
  52.   OutName  : String[NameN];  {Output file name}
  53.   Ans      : String[NameN];  {Operator's answer}
  54.   TempName : String[NameN];  {Temporary name of output file "d:ffffffff.$$$"}
  55.   DDrive   : String[2];   {Default drive, e.g. B:}
  56.   AnsKey   : String[72];  {Current input key string}
  57.   LastKey  : String[72];  {Previous input key string}
  58.   Key      : String[24];  {Input key string in standard form}
  59.   InFile   : file;        {Input file}
  60.   OutFile  : file;        {Output file}
  61.   ConFile  : file;        {Continuation file 'CRY.CON'}
  62.   KeyFile  : text;        {A text file with a one line key}
  63.   TBytes   : Real;        {Total bytes processed}
  64.   FError   : Boolean;     {File conversion error flag}
  65.   Exists   : Boolean;     {Output file already exists flag}
  66.   Encipher : Boolean;     {Encipher a file, False => Decipher}
  67.   InitCon  : Boolean;     {Initializing CRY.CON, False => Encipher/Decipher}
  68.   Repeat2  : Boolean;     {Repeat flag used in RN(2)}
  69.   ReadRecs : LongInt;     {No. of 1-byte records to read this read}
  70.   RemRecs  : LongInt;     {No. of 1-byte records remaining in file}
  71.   InCnt    : LongInt;     {# of Bytes read}
  72.   BufIO    : Buffer;      {I/O Buffer}
  73.   KeyI     : array [1..24] of Integer;  {Key in Integer form, 6 bits each}
  74.  
  75. {--------------------------------------}
  76. function RN(N : Integer): Integer;
  77.   {Returns the next random integer from RI[I], 0 <= N <= 8}
  78.   label Exit2;
  79.   var I, RT : Integer;
  80. begin
  81.   case N of
  82.     0: {1st Congruential Generator, 16 bits}
  83.        {Random integer from -32768 to 32767 inclusive}
  84.        {Cycle length = 65536 = 2^16}
  85.        begin
  86.          RI[0]:= 25173 * RI[0] + 6925;
  87.          RN:= RI[0];
  88.        end;
  89.  
  90.     1: {1st Shift-register Generator, 16 bits}
  91.        {Random integer from -32768 to 32767 inclusive, zero not generated}
  92.        {Generator = -22620, Cycle length = 65535 = 3 * 5 * 17 * 257}
  93.        begin
  94.          if Odd( RI[1]) then
  95.            RI[1]:= (RI[1] SHR 1) XOR -22620
  96.          else
  97.            RI[1]:= RI[1] SHR 1;
  98.          RN:= RI[1];
  99.        end;
  100.  
  101.     2: {2nd Congruential Generator, 16 bits}
  102.        {Random integer from -32768 to 32767 inclusive}
  103.        {Cycle length = 65537 = prime, zero repeats once}
  104.        begin
  105.          if RI[2] = 0 then begin
  106.            if Repeat2 then begin
  107.              Repeat2:= False;
  108.              goto Exit2;
  109.            end else
  110.              Repeat2:= True;
  111.          end;
  112.          RI[2]:= 23629 * RI[2] + 13849;
  113. Exit2:
  114.          RN:= RI[2];
  115.        end;
  116.  
  117.     3: {2nd Shift-register Generator, 16 bits}
  118.        {Random integer from -32768 to 32767, not all generated}
  119.        {Generator = -07493, Cycle length = 65521 = prime, (65535 - 15)}
  120.        begin
  121.          if Odd( RI[3]) then
  122.            RI[3]:= (RI[3] SHR 1) XOR - 7493
  123.          else
  124.            RI[3]:= RI[3] SHR 1;
  125.          if RI[3] = 1 then
  126.            for I := 1 to 14 do  RT:= RN(3);  {Throw 14 away}
  127.          RN:= RI[3];
  128.        end;
  129.  
  130.     4: {3rd Congruential Generator, 16 bits}
  131.        {Random integer from -32768 to 32767, not all generated}
  132.        {Cycle length = 65519 = prime, (65536 - 17)}
  133.        begin
  134.          RI[4]:= 4821 * RI[4] + 13001;
  135.          if RI[4] = 0 then
  136.            for I:= 1 to 17 do  RT:= RN(4);  {Throw 17 away}
  137.          RN:= RI[4];
  138.        end;
  139.  
  140.     5: {3rd Shift-register Generator, 16 bits}
  141.        {Random integer from -32768 to 32767, not all generated}
  142.        {Generator = -25501, Cycle length = 65497 = prime, (65535 - 39)}
  143.        begin
  144.          if Odd( RI[5]) then
  145.            RI[5]:= (RI[5] SHR 1) XOR -25501
  146.          else
  147.            RI[5]:= RI[5] SHR 1;
  148.          if RI[5] = 1 then
  149.            for I:= 1 to 38 do  RT:= RN(5);  {Throw 38 away}
  150.          RN:= RI[5];
  151.        end;
  152.  
  153.     6: {4th Congruential Generator, 16 bits}
  154.        {Random integer from -32768 to 32767, not all generated}
  155.        {Cycle length = 65479 = prime, (65536 - 57)}
  156.        begin
  157.          RI[6]:= 10349 * RI[6] + 7001;
  158.          if RI[6] = 0 then
  159.            for I:= 1 to 57 do  RT:= RN(6);  {Throw 57 away}
  160.          RN:= RI[6];
  161.        end;
  162.  
  163.     7: {4th Shift-register Generator, 16 bits}
  164.        {Random integer from -32768 to 32767, not all generated}
  165.        {Generator = -18916, Cycle length = 65449 = prime, (65535 - 87)}
  166.        begin
  167.          if Odd( RI[7]) then
  168.            RI[7]:= (RI[7] SHR 1) XOR -18916
  169.          else
  170.            RI[7]:= RI[7] SHR 1;
  171.          if RI[7] = 1 then
  172.            for I:= 1 to 86 do  RT:= RN(7);  {Throw 86 away}
  173.          RN:= RI[7];
  174.        end;
  175.  
  176.     8: {5th Congruential Generator, 16 bits}
  177.        {Random integer from -32768 to 32767, not all generated}
  178.        {Cycle length = 65447 = prime, (65536 - 89)}
  179.        begin
  180.          RI[8]:= 30133 * RI[8] + 14001;
  181.          if RI[8] = 0 then
  182.            for I:= 1 to 89 do  RT:= RN(8);  {Throw 89 away}
  183.          RN:= RI[8];
  184.        end;
  185.   end; {case N}
  186. end; {RN}
  187.  
  188. {--------------------------------------}
  189. function RC9 : Integer;  {Combination of RN(0) thru RN(8) one each}
  190.   var I, RC : Integer;
  191. begin
  192.   RC:= 0;
  193.   for I:= 0 to 8 do
  194.     RC:= RC + RN(I);
  195.   RC9:= RC;
  196. end; {RC9}
  197.  
  198. {--------------------------------------}
  199. procedure ChangeIt( var BufE : Buffer; Bytes : Integer);
  200.   {Apply pseudo key to Bytes bytes in place in BufE}
  201.   var I, Ind : Integer;
  202. begin
  203.        {This is the heart of the encryption method}
  204.  
  205.   with BufE do begin
  206.     for I:= 1 to ((Bytes+1) DIV 2) do begin
  207.       Ind:= RR AND PoolMask;
  208.       Int[I]:= Int[I] XOR Pool[Ind];
  209.       RR:= RR + RN( Next);
  210.       Pool[Ind]:= Pool[Ind] XOR RR;
  211.       Next:= Next + 1;
  212.       if Next = 9 then  Next:= 0;
  213.     end;
  214.   end;
  215. end; {ChangeIt}
  216.  
  217. {--------------------------------------}
  218. procedure ConvKey;  {Convert the encryption key to 9 seeds}
  219.                     { Input: Key[J], J = 1, ..., 24}
  220.                     { Output: RS[I], I = 0, ..., 8}
  221. var I, J, K : Integer;
  222. {
  223.     [0]    [1]    [2]    [3]    [4]    [5]    [6]    [7]  ...   [22]   [23]
  224.   111111 111111 111111 111111 111111 111111 111111 111111      111111 111111
  225.      6      6     4  2    6      6    2  4     6      6           6      6
  226.   ****** seed0 *****...... seed1 ......***** seed2 ****** ... * seed8 ******
  227.         16 bits           16 bits           16 bits            16 bits
  228.  
  229.   144 bit key converted to 144 bits of seed, seeds of zero are changed to 1.
  230. }
  231. begin
  232.   for I:= 1 to 24 do  KeyI[I]:= Ord( Key[I]) AND 63;
  233.   I:= 0;  J:= 1;
  234.   for K:= 0 to 2 do begin
  235.     RS[I]:=   (KeyI[J]   SHL 10) OR (KeyI[J+1] SHL 4) OR (KeyI[J+2] SHR 2);
  236.  
  237.     RS[I+1]:= (KeyI[J+2] SHL 14) OR (KeyI[J+3] SHL 8) OR (KeyI[J+4] SHL 2) OR
  238.               (KeyI[J+5] SHR 4);
  239.  
  240.     RS[I+2]:= (KeyI[J+5] SHL 12) OR (KeyI[J+6] SHL 6) OR KeyI[J+7];
  241.         I:= I + 3;  J:= J + 8;
  242.   end;
  243.   Repeat2:= True;
  244. end; {ConvKey}
  245.  
  246. {--------------------------------------}
  247. procedure Standard( var Key : String);  {Convert a key to Standard format}
  248.   var I : Integer;  {Utility index}
  249. begin
  250.   for I:= 1 to Length( Key) do begin
  251.     Key[I]:= Chr( Ord( Key[I]) AND 127);
  252.     if Ord( Key[I]) > 95 then  Key[I]:= Chr( Ord( Key[I]) - 32);
  253.     if Ord( Key[I]) < 32 then  Key[I]:= Chr( Ord( Key[I]) + 32);
  254.     if Key[I] = ' ' then  Key[I]:= '/';
  255.   end;
  256. end; {Standard}
  257.  
  258. {--------------------------------------}
  259. function TestStop : Boolean;  {Test for user quit request}
  260.   var Quit : Boolean;
  261. begin
  262.   TestStop:= False;
  263.   if StopTyped then begin
  264.     WriteLn;
  265.     Write('Do you wish to Quit the program ? (Y/N): ');
  266.     GetYesNo( Quit, HotHelp);
  267.     WriteLn;
  268.     TestStop:= Quit;
  269.     StopTyped:= True;
  270.   end;
  271. end; {TestStop}
  272.  
  273. {--------------------------------------}
  274. procedure GetKey;  {Get encryption key from operator}
  275.   label Exit3;
  276.   var  I,J  : Integer;  {Utility indexes}
  277.        Done : Boolean;  {Utility done flag}
  278.        Ch   : Char;     {Utility character}
  279. begin
  280.   WriteLn;
  281.   Done:= False;
  282.   repeat
  283.     WriteLn;
  284.     AnsKey:= LastKey;
  285.     repeat
  286.       WriteLn(
  287. 'Input a key of 0 to 72 characters that you can remember and press return:');
  288.       WriteLn('Or a key file name (F1 for help, F2 to Exit)   .<-- col. 48');
  289.       Prom( FirstCol, LastLine, 72, LastKey, AnsKey, HotHelp);
  290.       if TestStop then  goto Exit3;
  291.     until NOT StopTyped;
  292.     Assign (KeyFile, AnsKey);  { Try to open key file }
  293.     Reset( KeyFile);
  294.     if (IOResult = 0) AND (AnsKey <> '') then begin
  295.       Read( KeyFile, AnsKey);
  296.       Close( KeyFile);
  297.     end;
  298.     LastKey:= AnsKey;
  299.     WriteLn;
  300.     ChgLen( Key, 24, 24);  {24 long}
  301.     Standard( AnsKey);
  302.     WriteLn( AnsKey, ' = Input key in standard form');
  303.  
  304.     if Length( AnsKey) > 24 then begin
  305.       for I:= 2 to 24 do
  306.         AnsKey[I]:= Chr( Ord( AnsKey[I]) + Ord( AnsKey[I-1]));
  307.       J:= Length( AnsKey);
  308.       for I:= 26 to Length( AnsKey) do begin
  309.         J:= J-1;
  310.         AnsKey[J]:= Chr( Ord( AnsKey[J]) + Ord( AnsKey[J+1]));
  311.       end;
  312.     end;
  313.  
  314.     for I:= 1 to 24 do  Key[I]:= Chr(0);
  315.     J:= 1;
  316.     for I:= 1 to Length( AnsKey) do begin
  317.       Key[J]:= Chr( Ord( Key[J]) + Ord( AnsKey[I]));
  318.       J:= J MOD 24 + 1;
  319.     end;
  320.     for I:= 1 to 24 do
  321.       if (Key[I] = Chr(0)) then  Key[I]:= ' ';
  322.     Standard( Key);
  323.     ConvKey;
  324.     WriteLn( Key, ' = 24-character key in standard form');
  325.     WriteLn;
  326.     Write('Is this key what you want? (Y/N): ');
  327.     GetYesNo( Done, HotHelp);
  328.     if NOT Done then  WriteLn('Key rejected');
  329.   until Done;
  330.   WriteLn('Key accepted');
  331. Exit3:
  332. end; {GetKey}
  333.  
  334. {--------------------------------------}
  335. procedure GetTempName;  {Generate a temporary name for the output file}
  336.   var  I,J : Integer;   {Utility indexes}
  337. begin
  338.   if Exists then begin
  339.     ChgLen( TempName, NameN, NameN);  {NameN bytes long}
  340.     for I:= 1 to NameN do  TempName[I]:= ' ';  {All blanks}
  341.     for I:= 1 to Length( OutName) do  TempName[I]:= OutName[I];
  342.     J:= 0;
  343.     for I:= 1 to NameN do begin
  344.       if (TempName[I] = '.') OR (TempName[I] = ' ') then
  345.         if J = 0 then  J:= I;
  346.     end;
  347.     if J > (NameN - 3) then  J:= NameN - 3;
  348.     Insert('.$$$', TempName, J);
  349.   end else
  350.     TempName:= OutName;
  351. end; {GetTempName}
  352.  
  353. {--------------------------------------}
  354. procedure FixName;  {Add default drive d: to file name or set default drive}
  355. begin
  356.   if (Length( Ans) < 2) OR (Ans[2] <> ':') then
  357.     Ans:= DDrive + Ans;
  358.   if Length( Ans) = 2 then begin
  359.     DDrive:= Ans;
  360.     Ans:= '';
  361.   end;
  362. end; {FixName}
  363.  
  364. {--------------------------------------}
  365. procedure GetInName;  {Get name of input file and open for reading}
  366.   label Exit4;
  367.   var Done : Boolean;  {Utility done flag}
  368. begin
  369.   Done:= False;
  370.   repeat
  371.     repeat
  372.       WriteLn;
  373.       Ans:= InName;
  374.       repeat
  375.         Write('Default Drive = ', DDrive, '  Enter name of Input file: ');
  376.         Prom( FirstCol+47, LastLine, NameN, InName, Ans, HotHelp);
  377.         if TestStop then  goto Exit4;
  378.       until NOT StopTyped;
  379.       FixName;
  380.       InName:= Ans;
  381.     until (Length( InName) > 0);
  382.     WriteLn;
  383.     Assign( InFile, InName);
  384.     Reset( InFile, 1);
  385.     if IOResult = 0 then begin
  386.       RemRecs:= FileSize( InFile);
  387.       if RemRecs = 0
  388.         then  WriteLn('File "', InName, '" has zero length')
  389.         else  Done:= True;
  390.     end else
  391.       WriteLn('File "', InName, '" not found');
  392.   until Done;
  393. Exit4:
  394. end; {GetInName}
  395.  
  396. {--------------------------------------}
  397. procedure GetOutName;  {Get name of output file and open for rewrite}
  398.   label Exit5;
  399.   var Done : Boolean;  {Utility done flag}
  400. begin
  401.   Done:= False;
  402.   repeat
  403.     repeat
  404.       WriteLn;
  405.       Ans:= OutName;
  406.       repeat
  407.         Write('Default Drive = ', DDrive, '  Enter name of Output file: ');
  408.         Prom( FirstCol+47, LastLine, NameN, Ans, Ans, HotHelp);
  409.         if TestStop then  goto Exit5;
  410.       until NOT StopTyped;
  411.       FixName;
  412.       OutName:= Ans;
  413.     until (Length( OutName) > 0);
  414.     WriteLn;
  415.     Assign( OutFile, OutName);
  416.     Reset( OutFile, 1);
  417.     Exists:= False;
  418.     if IOResult = 0 then begin
  419.       Exists:= True;
  420.       Write('File "', OutName,
  421.         '" already exists, erase it after conversion? (Y/N): ');
  422.       GetYesNo( Done, HotHelp);
  423.       if TestStop then  goto Exit5;
  424.     end else
  425.       Done:= True;
  426.     if Done then begin
  427.       GetTempName;
  428.       Assign( OutFile, TempName);
  429.       Rewrite( OutFile, 1);
  430.       if IOResult <> 0 then begin
  431.         WriteLn('Cannot open output file');
  432.         Done:= False;
  433.       end;
  434.     end;
  435.   until Done;
  436. Exit5:
  437. end; {GetOutName}
  438.  
  439. {--------------------------------------}
  440. procedure GetEDI( var Value : Char;
  441.     HotHelpA : HotHelpT);  {Get E/D/I answer from operator}
  442.   var Ch : Char;  Done : Boolean;
  443. begin
  444.   Write('E', BS);
  445.   repeat
  446.     Ch:= ReadKeyM( HotHelpA);
  447.     Done:= Ch in ['E', 'e', 'D', 'd', 'I', 'i', CR, ESC, StopC];
  448.   until Done;
  449.   EscTyped:= (Ch = ESC);
  450.   StopTyped:= (Ch = StopC);
  451.   if StopTyped then  Ch:= ' ';
  452.   Value:= UpCase( Ch);
  453.   if (Value in [CR, ESC]) then  Value:= 'E';
  454.   WriteLn( Value);
  455. end; {GetEDI}
  456.  
  457. {--------------------------------------}
  458. procedure EncOrDec;  {Ask operator for Encipher or Decipher option}
  459.   var Ch : Char;  Done : Boolean;  Ans : String[1];
  460. begin
  461.   repeat
  462.     WriteLn;
  463.     Ans:= 'E';
  464.     Write('Encipher, Decipher or Init File CRY.CON? (E/D/I): ');
  465.     GetEDI( Ch, HotHelp);
  466.     if TestStop then  Exit;
  467.   until NOT StopTyped;
  468.   InitCon:=  Ch IN ['I', 'i'];
  469.   Encipher:= Ch IN ['E', 'e', CR];
  470.   if InitCon then  WriteLn('Init CRY.CON')
  471.   else if Encipher then  WriteLn('Encipher')
  472.   else if Ch IN ['D', 'd'] then  WriteLn('Decipher');
  473. end; {EncOrDec}
  474.  
  475. {--------------------------------------}
  476. procedure WriteIt;  {Write a multiple of 1 byte records}
  477. begin
  478.   BlockWrite( OutFile, BufIO, ReadRecs);
  479.   if IOResult <> 0 then begin
  480.     WriteLn('Unable to write output file');
  481.     FError:= True;
  482.   end;
  483. end; {WriteIt}
  484.  
  485. {--------------------------------------}
  486. procedure InitEn;  {Initialize for enciphering}
  487.   var RecS : Integer;
  488. begin
  489.   Assign( ConFile, 'CRY.CON');
  490.   Reset( ConFile, 1);
  491.   if IOResult = 0 then begin
  492.     RecS:= FileSize( ConFile);
  493.     if RecS <> ConSize then begin
  494.       WriteLn('File CRY.CON not of proper length');
  495.       FError:= True;
  496.     end;
  497.   end
  498.   else begin
  499.     WriteLn('File CRY.CON not found');
  500.     FError:= True;
  501.   end;
  502.   if NOT FError then begin
  503.     BlockRead( ConFile, Pool, ConSize);
  504.     if IOResult <> 0 then begin
  505.       WriteLn('Can not read file CRY.CON');
  506.       FError:= True;
  507.     end
  508.     else begin
  509.       BlockWrite( OutFile, Pool, ConSize);
  510.       if IOResult <> 0 then begin
  511.         WriteLn('Unable to write 1st record of output file');
  512.         FError:= True;
  513.       end;
  514.     end;
  515.   end;
  516.   Close( ConFile);
  517.   if IOResult <> 0 then begin
  518.     WriteLn('Can close file CRY.CON');
  519.     FError:= True;
  520.   end;
  521. end; {InitEn}
  522.  
  523. {--------------------------------------}
  524. procedure InitDe;  {Initialize for deciphering}
  525. begin
  526.   RemRecs:= RemRecs - ConSize;
  527.   if RemRecs = 0 then begin
  528.     WriteLn('File "', InName, '" is too short for an enciphered file');
  529.     FError:= True;
  530.   end
  531.   else begin
  532.     BlockRead( InFile, Pool, ConSize);
  533.     if IOResult <> 0 then begin
  534.       WriteLn('Unable to read 1st record of input file');
  535.       FError:= True;
  536.     end;
  537.   end;
  538. end; {InitDe}
  539.  
  540. {--------------------------------------}
  541. procedure WriteCon;  {Write CRY.CON to disk}
  542.   var I : Integer;
  543. begin
  544.   Assign( ConFile, 'CRY.CON');
  545.   Rewrite( ConFile, 1);
  546.   if IOResult <> 0 then begin
  547.     WriteLn('Can not open file CRY.CON');
  548.     FError:= True;
  549.   end
  550.   else begin
  551.     for I:= 0 to 8 do
  552.       RI[I]:= RC[I];
  553.     for I:= PoolSize-1 downto 0 do
  554.       Pool[I]:= RC9;
  555.     BlockWrite( ConFile, Pool, ConSize);
  556.     if IOResult <> 0 then begin
  557.       WriteLn('Unable to write file CRY.CON');
  558.       FError:= True;
  559.     end;
  560.     Close( ConFile);
  561.     if IOResult <> 0 then begin
  562.       WriteLn('Can close file CRY.CON');
  563.       FError:= True;
  564.     end;
  565.   end;
  566.   if FError then
  567.     Write('File CRY.CON update Aborted');
  568. end; {WriteCon}
  569.  
  570. {--------------------------------------}
  571. procedure InitPool;  {Initialize pool of random integers}
  572.   var I : Integer;
  573. begin
  574.   for I:= 0 to 8 do begin
  575.     RC[I]:= Pool[I];
  576.     RI[I]:= RS[I] XOR Pool[I];
  577.     if RI[I] = 0 then  RI[I]:= 1;
  578.   end;
  579.   RR:= RC9;
  580.   for I:= 0 to PoolSize-1 do begin
  581.     RR:= RR + RN( Next);
  582.     Pool[I]:= RR;
  583.     Next:= Next + 1;
  584.     if Next = 9 then  Next:= 0;
  585.   end;
  586.   RR:= RC9;
  587. end; {InitPool}
  588.  
  589. {--------------------------------------}
  590. procedure DoInitCon;  {Initialize file CRY.CON}
  591.   var I  : Integer;
  592.       Ch : Char;
  593. begin
  594.   FError:= False;
  595.   Assign( ConFile, 'CRY.CON');
  596.   Rewrite( ConFile, 1);
  597.   if IOResult <> 0 then begin
  598.     WriteLn('Can not open file CRY.CON');
  599.     FError:= True;
  600.   end
  601.   else begin
  602.     for I:= 0 to 8 do
  603.       RI[I]:= RS[I];
  604.     for I:= PoolSize-1 downto 0 do
  605.       Pool[I]:= RC9;
  606.     BlockWrite( ConFile, Pool, ConSize);
  607.     if IOResult <> 0 then begin
  608.       WriteLn('Unable to write file CRY.CON');
  609.       FError:= True;
  610.     end;
  611.     Close( ConFile);
  612.     if IOResult <> 0 then begin
  613.       WriteLn('Can close file CRY.CON');
  614.       FError:= True;
  615.     end;
  616.   end;
  617.   if FError then
  618.     Write('File CRY.CON initialization Aborted')
  619.   else
  620.     Write('File CRY.CON initialized successfully');
  621.   WriteLn(', hit any key to continue ...');
  622.   Ch:= ReadKey;
  623. end; {DoInitCon}
  624.  
  625. {--------------------------------------}
  626. procedure EraseKey;  {Erase all trace of the encryption key}
  627.   var I : Integer;
  628. begin
  629.   for I:= 1 to 72 do  AnsKey[I]:= ' ';
  630.   for I:= 1 to 24 do begin
  631.     Key[I]:= ' ';  KeyI[I]:= 0;
  632.   end;
  633.   for I:= 0 to 8  do begin
  634.     RI[I]:= 0;  RS[I]:= 0;
  635.   end;
  636.   for I:= 0 to PoolSize-1 do
  637.     Pool[I]:= 0;
  638.   RR:= 0;
  639. end; {EraseKey}
  640.  
  641. {--------------------------------------}
  642. procedure Process;  {Process input file to output file}
  643.   var Ans : String[1];  {Utility operator's answer}
  644.       Ch  : Char;       {Utility character}
  645.       I   : Integer;
  646. begin
  647.   TBytes:= 0;
  648.   FError:= False;
  649.   if Encipher
  650.     then  InitEn
  651.     else  InitDe;
  652.   if NOT FError then begin
  653.     InitPool;
  654. {DIAG
  655. for I:= 0 to 8 do  Write('RS[', I, '] = ', RS[I], '  ');
  656. for I:= 0 to 8 do  Write('RI[', I, '] = ', RI[I], '  ');}
  657.     repeat
  658. {DIAG  WriteLn('DIAG: RemRecs = ', RemRecs);}
  659.       if BufRecSize < RemRecs
  660.         then  ReadRecs:= BufRecSize
  661.         else  ReadRecs:= RemRecs;
  662.       BlockRead( InFile,  BufIO, ReadRecs);
  663.       if IOResult = 0 then begin
  664.         InCnt:= 1 * ReadRecs;
  665.         TBytes:= TBytes + InCnt;
  666.         ChangeIt( BufIO, InCnt);  {Apply pseudo key}
  667.         WriteIt;
  668.         RemRecs:= RemRecs - ReadRecs;
  669.       end
  670.       else begin
  671.         WriteLn('Unable to read input file');
  672.         FError:= True;
  673.       end;
  674.       WriteLn( TBytes:8:0, ' Bytes Processed');
  675.     until (RemRecs = 0) OR FError;
  676.   end;
  677.   Close( OutFile);
  678.   if IOResult <> 0 then begin
  679.     WriteLn('Unable to close output file');
  680.     FError:= True;
  681.   end;
  682.   Close( InFile);
  683.   if IOResult <> 0 then  WriteLn('Unable to close input file');
  684.   if FError then begin
  685.     if Exists then  Erase( OutFile);
  686.     Write('File conversion Aborted');
  687.   end
  688.   else begin
  689.     if Exists then begin
  690.       Assign( OutFile, OutName);
  691.       Erase( OutFile);
  692.       Assign( OutFile, TempName);
  693.       Rename( OutFile, OutName);
  694.     end;
  695.     WriteCon;
  696.     Write('File converted successfully');
  697.   end;
  698.   WriteLn(', hit any key to continue ...');
  699.   Ch:= ReadKey;
  700. end; {Process}
  701.  
  702. {--------------------------------------}
  703. procedure Init;  {Initialize program only once}
  704.   var I : Integer;  {Utility index}
  705. begin
  706.   TextBackground( Blue);
  707.   TextColor( Yellow);
  708.   ClrScr;
  709.   GoToXY( FirstCol, LastLine);
  710.   Title;
  711.   WriteLn;
  712.   LastKey:= 'ABCDEF';
  713.   DDrive:=  'A:';
  714.   InName:=  'B:';
  715.   OutName:= 'B:';
  716.   WriteLn;
  717.   IndLn(2,
  718.  'Select characters for your key from the following list of 64 characters:');
  719.   WriteLn; Write(' ':29);
  720.   for I:= 0 to 15 do  Write( Chr( I+64));  WriteLn; Write(' ':29);
  721.   for I:= 0 to 15 do  Write( Chr( I+80));  WriteLn; Write(' ':29);
  722.   for I:= 0 to 15 do  Write( Chr( I+32));  WriteLn; Write(' ':29);
  723.   for I:= 0 to 15 do  Write( Chr( I+48));  WriteLn;
  724.   WriteLn; IndLn(2,
  725. 'Your key will be converted to a 24-character key in standard form.'
  726.   ); IndLn(2,
  727. 'The standard form is then used to compute seeds for the nine different'
  728.   ); IndLn(2,
  729. 'random number generators used to produce the pseudo infinite key.'
  730.   ); IndLn(2,
  731. 'The generated pseudo infinite key will not repeat itself until after it is'
  732.   ); IndLn(2,
  733. 'about 2**148 bits long.'
  734.   );
  735. end; {Init}
  736.  
  737. {--------------------------------------}
  738. begin {Main program (CryU)}
  739.   Init;
  740.   repeat
  741.     Next:= 0;
  742.     GetKey;     if StopTyped then  goto Exit1;
  743.     EncOrDec;   if StopTyped then  goto Exit1;
  744.     if InitCon then  DoInitCon
  745.     else begin
  746.       InName:= OutName;  {Default InName is last OutName}
  747.       GetInName;         if StopTyped then  goto Exit1;
  748.       OutName:= InName;  {Default OutName is last InName}
  749.       GetOutName;        if StopTyped then  goto Exit1;
  750.       Process;
  751.     end;
  752.     Continue:
  753.   until False;  {F2 to stop}
  754.   Exit1:
  755.   EraseKey;
  756. end. {Main program (CryU)}
  757.  
  758. {End of file CryU.PAS ******************************************************}
  759.