home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / ENCIPHER.ZIP / ENCIPHER.PAS next >
Encoding:
Pascal/Delphi Source File  |  1986-01-21  |  4.3 KB  |  156 lines
  1.  
  2. PROGRAM ENCIPHER(fileName); 
  3. {This program may be freely copied and modified.} 
  4.  
  5. TYPE 
  6.    extension = STRING[4]; 
  7.    name = STRING[14]; 
  8. VAR 
  9.    fileName: FILE; 
  10.    i, stop, blocks: INTEGER; 
  11.    answer: CHAR; 
  12.    fileIn: name; 
  13.    transKey, subKey: ARRAY[0..127] OF INTEGER; 
  14.    buffer: ARRAY[0..MAXINT] OF CHAR; 
  15.    ext: extension; 
  16.  
  17.  
  18. FUNCTION fileExist(fileName: name): BOOLEAN; {Test to 
  19.                              see if file already exists.} 
  20.  
  21. VAR 
  22.    testFile: FILE; 
  23. BEGIN 
  24.    ASSIGN(testFile, fileName); {$I-} 
  25.    RESET(testFile); {$I+} 
  26.    IF IORESULT <> 0 THEN fileExist:= FALSE ELSE fileExist:=TRUE; 
  27. END; 
  28.  
  29.  
  30. PROCEDURE initialize; {Reads in the substitution and transposition
  31.                       keys from keyFile.} 
  32. VAR 
  33.    dataFile: TEXT; 
  34. BEGIN 
  35.    ASSIGN(dataFile,'keyFile'); 
  36.    RESET(dataFile); 
  37.    FOR i:= 0 TO 127 DO READ(dataFile,subKey[i]); 
  38.    READLN(dataFile); 
  39.    FOR i:= 0 TO 63 DO READ(dataFile,transKey[i]); 
  40.    CLOSE(dataFile); 
  41. END; {of initialize} 
  42.  
  43.  
  44. PROCEDURE transpose; {Transposes 64 characters with the next 64 
  45.                      using the transpose key.} 
  46. VAR 
  47.    tempstore: CHAR; 
  48.    switchIndex, increment: INTEGER; 
  49. BEGIN 
  50.    increment:= 63;  i:= 0; 
  51.    WHILE i < stop DO 
  52.       BEGIN 
  53.          tempstore:= buffer[i]; 
  54.          switchIndex:= increment + transKey[i MOD 64]; 
  55.          buffer[i]:= buffer[switchIndex]; 
  56.          buffer[switchIndex]:= tempstore; 
  57.          i:= i+1; 
  58.          IF i MOD 64 = 0 THEN 
  59.             BEGIN 
  60.                i:= i + 64; 
  61.                increment:= increment + 128; 
  62.             END; 
  63.       END; 
  64. END; {of transpose} 
  65.  
  66.  
  67. PROCEDURE logicalXor; {Performs a logical xor of the file with the 
  68.                        substitution key.} 
  69. BEGIN 
  70.    FOR i:= 0 TO stop - 1 DO 
  71.    buffer[i]:= CHR(ORD(buffer[i]) XOR subKey[i MOD 128]); 
  72. END; {of logicalXor} 
  73.  
  74.  
  75. PROCEDURE readFile; {Reads in the file to be encrypted or decrypted
  76.                      and finds the file size.} 
  77. BEGIN 
  78.    READLN(fileIn); 
  79.    WRITELN; 
  80.    ASSIGN(fileName,fileIn); 
  81.    RESET(fileName); 
  82.    blocks:= FILESIZE(fileName); 
  83.    stop:= 128*blocks - 1; 
  84.    BLOCKREAD(fileName,buffer,blocks); 
  85.    CLOSE(fileName); 
  86. END; {of readFile} 
  87.  
  88.  
  89. PROCEDURE writeFile(VAR ext: extension);  {Writes the encrypted or 
  90.                               decrypted file and renames with ext.} 
  91. VAR 
  92.    period: INTEGER; 
  93. BEGIN 
  94.    CASE answer OF 
  95.    'E','e': WRITELN(fileIn,' is to be ENCRYPTED.  Enter Y or N.'); 
  96.    'D','d': WRITELN(fileIn,' is to be DECRYPTED.  Enter Y or N.'); 
  97.    END; 
  98.    READLN(answer); 
  99.    IF answer IN ['y','Y'] THEN 
  100.      BEGIN 
  101.         REWRITE(fileName); 
  102.         BLOCKWRITE(fileName,buffer,blocks); 
  103.         CLOSE(fileName); 
  104.         period:= POS('.',fileIn); 
  105.         IF period > 0 THEN DELETE(fileIn,period,4); 
  106.         fileIn:= fileIn + ext; 
  107.         IF fileExist(fileIn) THEN 
  108.         WRITELN('NOTE! DUPLICATE NAMES. ORIGINAL FILE NAME KEPT.') 
  109.         ELSE RENAME(fileName,fileIn); 
  110.      END 
  111.    ELSE WRITELN('FINAL FILE NOT WRITTEN.  ORIGINAL FILE INTACT.');
  112. END; {of writeFile} 
  113.  
  114.  
  115. PROCEDURE encrypt; {Encryption as substitution, transposition,
  116.                     and logical xor.} 
  117. BEGIN 
  118.    WRITELN('Enter the name of the file you wish to ENCRYPT:');
  119.    readFile; 
  120.    FOR i:= 0 TO stop-1 DO 
  121.    buffer[i]:= CHR(ORD(buffer[i]) + subKey[i MOD 128]); 
  122.    transpose; 
  123.    logicalXor; 
  124.    ext:= '.enc'; 
  125.    writeFile(ext); 
  126. END; {of encrypt} 
  127.  
  128.  
  129. PROCEDURE decrypt; {Decryption as the inverse of encryption.}
  130.  
  131. BEGIN 
  132.    WRITELN('Enter the name of the file you wish to DECRYPT');
  133.    readFile; 
  134.    logicalXor; 
  135.    transpose; 
  136.    FOR i:= 0 TO stop-1 DO 
  137.    buffer[i]:= CHR(ORD(buffer[i]) - subKey[i MOD 128]); 
  138.    ext:= '.clr'; 
  139.    writeFile(ext); 
  140. END; {of decrypt} 
  141.  
  142. { ***** END OF PROCEDURES ***** } 
  143.  
  144. BEGIN 
  145.    initialize; 
  146.    WRITELN('Encrypt, Decrypt, or Terminate (E/D/T)?'); 
  147.    WRITELN; 
  148.    READLN(answer); 
  149.    CASE answer OF 
  150.    'E','e': encrypt; 
  151.    'D','d': decrypt; 
  152.    'T','t': WRITELN('TERMINATING. NO ACTION TAKEN.'); 
  153.    ELSE WRITELN('ILLEGAL RESPONSE. TERMINATING. NO ACTION TAKEN.');
  154.    END; 
  155. END. 
  156.