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