home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PIBCIPHR.ZIP / ENCRYPT.VMS < prev    next >
Encoding:
Text File  |  1989-04-28  |  11.9 KB  |  290 lines
  1. (*$R-,V-,S-*)
  2. PROGRAM Encrypt( Input , Output );
  3.  
  4. (*----------------------------------------------------------------------*)
  5. (*               Encrypt --- Vigenere encryption program                *)
  6. (*----------------------------------------------------------------------*)
  7. (*                                                                      *)
  8. (*  Author:   Philip R. Burns.                                          *)
  9. (*                                                                      *)
  10. (*  Date:     January, 1989                                             *)
  11. (*  Version:  1.0   (January, 1989)                                     *)
  12. (*            1.1   (April, 1989)                                       *)
  13. (*                                                                      *)
  14. (*  Systems:  VAX/VMS and IBM PC Turbo Pascal.                          *)
  15. (*                                                                      *)
  16. (*  Usage:    On the Vax:                                               *)
  17. (*                                                                      *)
  18. (*               Prepare a file called ENC.COM with the following       *)
  19. (*               DCL statements:                                        *)
  20. (*                                                                      *)
  21. (*                 $ assign/user 'p1' pas$input                         *)
  22. (*                 $ assign/user 'p2' pas$output                        *)
  23. (*                 $ run encrypt                                        *)
  24. (*                                                                      *)
  25. (*               Define an appropriate DCL command like the following:  *)
  26. (*                                                                      *)
  27. (*                  Encrypt == "@ENC"                                   *)
  28. (*                                                                      *)
  29. (*               Then to encrypt a file, enter:                         *)
  30. (*                                                                      *)
  31. (*                  Encrypt source result                               *)
  32. (*                                                                      *)
  33. (*                     source --- name of source file to be encrypted   *)
  34. (*                     result --- name of result file after encryption  *)
  35. (*                                                                      *)
  36. (*               Example:                                               *)
  37. (*                                                                      *)
  38. (*                  Encrypt mymess.let mymess.enc                       *)
  39. (*                                                                      *)
  40. (*            On the PC:                                                *)
  41. (*                                                                      *)
  42. (*               Encrypt <source >result                                *)
  43. (*                                                                      *)
  44. (*               Example:                                               *)
  45. (*                                                                      *)
  46. (*                  Encrypt <mymess.let >mymess.enc                     *)
  47. (*                                                                      *)
  48. (*  Remarks:  This program encrypts a text file using a variation of    *)
  49. (*            the Vigenere substitution cipher.                         *)
  50. (*                                                                      *)
  51. (*            These routines assume that the input text consists of the *)
  52. (*            lower 128 Ascii characters only.                          *)
  53. (*                                                                      *)
  54. (*            Control characters are not encoded, nor are they produced *)
  55. (*            as a result of the encryption.                            *)
  56. (*                                                                      *)
  57. (*            The companion program "decrypt" can be used to recover    *)
  58. (*            the original text from the encrypted text.                *)
  59. (*                                                                      *)
  60. (*            "/*" and "*/" are used in place of the usual comment      *)
  61. (*            delimeters in the nested comments for the "other"         *)
  62. (*            machine, since the Vax doesn't like nested comments.      *)
  63. (*                                                                      *)
  64. (*            I am contributing this program to the public domain.      *)
  65. (*                                                                      *)
  66. (*----------------------------------------------------------------------*)
  67.  
  68. { ===== START VAX/VMS CODE ===== }
  69.  
  70. TYPE
  71.    AnyStr      = VARYING[255] OF CHAR (* Varying length string *);
  72.    LongInteger = INTEGER              (* 32-bit integer type   *);
  73.  
  74. { ===== END VAX/VMS CODE ===== }
  75.  
  76. { ===== START PC TURBO PASCAL CODE =====                              }
  77. {                                                                     }
  78. { TYPE                                                                }
  79. {    AnyStr      = STRING[255]       /* Varying length string */;     }
  80. {    LongInteger = LONGINT           /* 32-bit integer type   */;     }
  81. {                                                                     }
  82. { ===== END PC TURBO PASCAL CODE =====                                }
  83.  
  84. CONST
  85.    First_Char  = 0                 (* First ascii character = NUL  *);
  86.    Last_Char   = 127               (* Last ascii character = DEL   *);
  87.    Control_End = 31                (* Last ascii control character *);
  88.    Blank_Char  = 32                (* Ascii blank                  *);
  89.  
  90.                                    (* # of non-control characters  *)
  91.  
  92.    Span        = ( Last_Char - Blank_Char );
  93.  
  94. VAR
  95.    MsgLine   : AnyStr              (* One line of message          *);
  96.    StringKey : AnyStr              (* Encryption string            *);
  97.    RanSeed   : LongInteger         (* Random number seed           *);
  98.  
  99. (*----------------------------------------------------------------------*)
  100. (*            Portable random-number generator routines.                *)
  101. (*----------------------------------------------------------------------*)
  102. (*                                                                      *)
  103. (*   These routines provide a portable way of producing uniformly       *)
  104. (*   distributed random numbers between 0 and 1.  The reason for        *)
  105. (*   using these routines rather than the standard system routines      *)
  106. (*   is so that files may be encrypted on one machine, e.g., the Vax,   *)
  107. (*   and then decrypted on the PC, or vice versa.                       *)
  108. (*                                                                      *)
  109. (*----------------------------------------------------------------------*)
  110.  
  111. CONST
  112.    M  = 714025;
  113.    IA = 1366;
  114.    IC = 150889;
  115.    RM = 1.400512E-6;
  116.  
  117. VAR
  118.    Y : LongInteger;
  119.    R : ARRAY[1..97] OF LongInteger;
  120.  
  121. (*----------------------------------------------------------------------*)
  122. (*      SetRandom --- Set the seed for the random number generator      *)
  123. (*----------------------------------------------------------------------*)
  124.  
  125. PROCEDURE SetRandom( VAR Seed : LongInteger );
  126.  
  127. VAR
  128.    J : INTEGER;
  129.  
  130. BEGIN (* SetRandom *)
  131.  
  132.    IF ( Seed > 0 ) THEN
  133.       Seed := -Seed;
  134.  
  135.    Seed := ( IC - Seed ) MOD M;
  136.  
  137.    FOR J := 1 TO 97 DO
  138.       BEGIN
  139.          Seed   := ( IA * Seed + IC ) MOD M;
  140.          R[ J ] := Seed;
  141.       END;
  142.  
  143.    Seed := ( IA * Seed + IC ) MOD M;
  144.    Y    := Seed;
  145.  
  146. END   (* SetRandom *);
  147.  
  148. (*----------------------------------------------------------------------*)
  149. (*         Random --- Get a uniform random number between 0 and 1       *)
  150. (*----------------------------------------------------------------------*)
  151.  
  152. FUNCTION Random( VAR Seed : LongInteger ) : REAL;
  153.  
  154. VAR
  155.    J : INTEGER;
  156.  
  157. BEGIN (* Random *)
  158.  
  159.    J := 1 + ( 97 * Y ) DIV M;
  160.  
  161.    IF ( J < 1 ) THEN
  162.       J := 1
  163.    ELSE IF ( J > 97 ) THEN
  164.       J := 97;
  165.  
  166.    Y      := R[ J ];
  167.    Random := Y * RM;
  168.  
  169.    Seed   := ( IA * Seed + IC ) MOD M;
  170.    R[ J ] := Seed;
  171.  
  172. END   (* Random *);
  173.  
  174. (*----------------------------------------------------------------------*)
  175. (*        Encode --- Encryption of text using Vigenere algorithm        *)
  176. (*----------------------------------------------------------------------*)
  177.  
  178. PROCEDURE Encode( VAR Message : AnyStr );
  179.  
  180. VAR
  181.    Index : INTEGER;
  182.  
  183. BEGIN (* Encode *)
  184.  
  185.     FOR Index := 1 TO LENGTH( Message ) DO
  186.        IF ( ( ORD( Message[ Index ] ) > Control_End ) AND
  187.             ( ORD( Message[ Index ] ) < Last_Char   )      ) THEN
  188.           Message[ Index ] := CHR( ( ORD( Message[ Index ] ) - Blank_Char +
  189.                                      TRUNC( Random( RanSeed ) * Span ) ) MOD Span +
  190.                                      Blank_Char );
  191.  
  192. END   (* Encode *);
  193.  
  194. (*----------------------------------------------------------------------*)
  195. (*         LXOR --- Find logical exclusive OR of two integers           *)
  196. (*----------------------------------------------------------------------*)
  197.  
  198. FUNCTION LXOR( I , J : LongInteger ) : LongInteger;
  199.  
  200. VAR
  201.    BXOR : LongInteger;
  202.  
  203. BEGIN (* LXOR *)
  204.  
  205. { ===== START VAX/VMS CODE ===== }
  206.  
  207.    BXOR :: BOOLEAN := XOR( I :: BOOLEAN , J :: BOOLEAN );
  208.    LXOR := BXOR;
  209.  
  210. { ===== END VAX/VMS CODE ===== }
  211.  
  212. { ===== START PC TURBO PASCAL CODE ===== }
  213. {                                        }
  214. {  LXOR := I XOR J;                      }
  215. {                                        }
  216. { ===== END PC TURBO PASCAL CODE =====   }
  217.  
  218. END   (* LXOR *);
  219.  
  220. (*----------------------------------------------------------------------*)
  221. (*  LSHL --- Perform left shift of integer by specified # of bits       *)
  222. (*----------------------------------------------------------------------*)
  223.  
  224. FUNCTION LSHL( I : LongInteger; NBits : INTEGER ) : LongInteger;
  225.  
  226. BEGIN (* LSHL *)
  227.  
  228. { ===== START VAX/VMS CODE ===== }
  229.  
  230.    LSHL := I * ( 2 ** NBits );
  231.  
  232. { ===== END VAX/VMS CODE ===== }
  233.  
  234. { ===== START PC TURBO PASCAL CODE ===== }
  235. {                                        }
  236. {  LSHL := I SHL NBits;                  }
  237. {                                        }
  238. { ===== END PC TURBO PASCAL CODE =====   }
  239.  
  240. END   (* LSHL *);
  241.  
  242. (*----------------------------------------------------------------------*)
  243. (*     Calc_Hash --- Hash key string to find seed for random number     *)
  244. (*----------------------------------------------------------------------*)
  245.  
  246. FUNCTION Calc_Hash( Key : AnyStr ) : LongInteger;
  247.  
  248. VAR
  249.    Index  : INTEGER;
  250.    Sum    : LongInteger;
  251.  
  252. BEGIN (* Calc_Hash *)
  253.  
  254.    Sum    := 0;
  255.                                    (* Exclusive OR characters together *)
  256.  
  257.    FOR Index := 1 TO LENGTH( Key ) DO
  258.       Sum := LXOR( LSHL( Sum , 1 ) , ORD( Key[ Index ] ) );
  259.  
  260.                                    (* Square result and subtract 31 to *)
  261.                                    (* produce initial seed.            *)
  262.    Calc_Hash := Sum * Sum - 31;
  263.  
  264. END   (* Calc_Hash *);
  265.  
  266. (*****************************************************************************)
  267.  
  268. BEGIN (* Encrypt *)
  269.                                    (* ASSIGN KEY HERE!!! *)
  270.  
  271.    StringKey := 'Veni, Vidi, Vici';
  272.  
  273.                                    (* Initialize random number from key *)
  274.  
  275.    RanSeed := Calc_Hash( StringKey );
  276.  
  277.    SetRandom( RanSeed );
  278.                                    (* Encrypt all lines in input file *)
  279.    REPEAT
  280.                                    (* Read next line of input *)
  281.       READLN ( MsgLine );
  282.                                    (* Encrypt text *)
  283.       Encode ( MsgLine );
  284.                                    (* Write encrypted text to output file *)
  285.       WRITELN( MsgLine );
  286.                                    (* Until no more input lines left *)
  287.    UNTIL ( EOF );
  288.  
  289. END   (* Encrypt *).
  290.