Use simple encryption/decryption algorithm on COBOL PIC X fields

1 Likes

over 8 years ago

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.