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