Created On:  05 November 2012

Problem:

A customer was looking for a simple method of using a key to encrypt/decrypt string fields in COBOL so that they could be used to encrypt data in a file.  Is there an example of doing this?

Resolution:

This is intended only to obscure a string from a casual prying eye. It is NOT intended to be a replacement for true encryption like 3DES and RSA encryption. Please do NOT assume this routine is in any way secure or uncrackable.

Essentially, The code uses a variable length key to obscure the original string by iterating through the string you want obscured and adding the ASCII value of the character at each position of the original string with the ASCII value of a rotating “key character” in the key provided to generate a new ASCII value. This new ASCII value is then converted to a character and added to the newly encrypted string. The obscured string is further obscured by the fact that the original string is reversed prior to being changed.

This key position changes after each character in the original string is obscured. The result is the key is iterated through sequentially as the original string is encrypted and when the end of the key string is encountered the iteration through the key string is started again from the beginning of the key string until the original string is completely encrypted.

This process works because the ASCII values in the typical string and the typical key string when added together do not exceed 255. (The highest possible ASCII character) Essentially, Strings and Keys with ASCII values higher than 126 should not be used or the result could be unpredictable– or worse yet, an unencryptable string.

The code below assumes that a pic x(256) field is used to hold both the string to encrypt and the key to use.
Trailing spaces will be ignored.

Calling main program:
Main program:
       id division.                                                   
       program-id.   nxtest.                                          
       working-storage section.                                       
       01 str        pic x(256)   value spaces.                       
       01 key1       pic x(256)   value spaces.                       
       01 function1  pic 9.                                           
          88 encrypt             value 1.                             
          88 decrypt             value 2.                             
       procedure division.                                            
                                                                      
           move "Now is the time for all good men To come To the aid "
             & "of their fellow countrymen." to str                   
           move "huasHIYhkasdho1" to key1                             
           set encrypt to true                                        
           call "nxencryption" using function1 str key1               
           display str                                                
           set decrypt to true                                        
           call "nxencryption" using function1 str key1               
           display str                                                
           goback.                                                    

and subprogram nxencryption.cbl

       id division.                                                   
       program-id.   nxencryption.                                    
       working-storage section.                                       
       01 charx1     pic x.                                           
       01 char-val1  pic x comp-x redefines charx1.                   
       01 charx2     pic x.                                           
       01 char-val2  pic x comp-x redefines charx2.                   
       01 lenkey     pic 9(9)    value 0.                             
       01 keypos     pic 9(9)    value 0.                             
       01 lenstr     pic 9(9)    value 0.                             
       01 newstr     pic x(256)  value spaces.                        
       01 newpos     pic 9(9)    value 1.                             
       linkage section.                                               
       01 function1  pic 9.                                           
          88 encrypt             value 1.                             
          88 decrypt             value 2.                             
       01 str        pic x(256).                                      
       01 key1       pic x(256).                                      
       procedure division using function1 str key1.                   
                                                                      
           if encrypt                                                 
              perform 100-encrypt                                     
           else                                                       
              perform 105-decrypt                                     
           end-if                                                     
           goback.                                                    
                                                                      
       100-encrypt.                                                   
                                                                      
           perform varying lenkey from length of key1 by -1           
              until lenkey < 1                                        
              if key1(lenkey:1) not = " "                             
                 exit perform                                         
              end-if                                                  
           end-perform                                                
                                                                      
           perform varying lenstr from length of str by -1            
              until lenstr < 1                                        
              if str(lenstr:1) not = " "                              
                 move function reverse(str(1:lenstr)) to str          
                 exit perform                                         
              end-if                                                  
           end-perform                                                
                                                                      
           move spaces to newstr                                      
           move 1 to keypos                                           
                                                                      
           perform varying newpos from 1 by 1                         
              until newpos > lenstr                                   
              move str(newpos:1) to charx1                            
              move key1(keypos:1) to charx2                           
              compute char-val1 = char-val1 + char-val2               
              move charx1 to newstr(newpos:1)                         
              add 1 to keypos                                         
              if keypos > lenkey                                      
                 move 1 to keypos                                     
              end-if                                                  
           end-perform                                                
           move newstr to str.                                        
                                                                      
       105-decrypt.                                                   
                                                                      
           perform varying lenkey from length of key1 by -1           
              until lenkey < 1                                        
              if key1(lenkey:1) not = " "                             
                 exit perform                                         
              end-if                                                  
           end-perform                                                
                                                                      
           perform varying lenstr from length of str by -1            
              until lenstr < 1                                        
              if str(lenstr:1) not = " "                              
                 move str(1:lenstr) to str                            
                 exit perform                                         
              end-if                                                  
           end-perform                                                
                                                                      
           move spaces to newstr                                      
           move 1 to keypos                                           
                                                                      
           perform varying newpos from 1 by 1                         
              until newpos > lenstr                                   
              move str(newpos:1) to charx1                            
              move key1(keypos:1) to charx2                           
              compute char-val1 = char-val1 - char-val2               
              move charx1 to newstr(newpos:1)                         
              add 1 to keypos                                         
              if keypos > lenkey                                      
                 move 1 to keypos                                     
              end-if                                                  
           end-perform                                                
           move function reverse(newstr(1:lenstr)) to str.            
                                                                      

Incident #2599923