Visual Basic for Applications/Simple Vigenere Cipher in VBA

Summary This VBA code module runs the sixteenth century Vigenere cipher. It is used to conceal the contents of a message, and was probably used in short term military messaging . The method is an early example of an attempt to disguise the natural frequency of the language used in communication. The sender and recipient share a secret word or phrase, the so-called key, used to scramble (encrypt) and unscramble (decrypt) the message. The code does not include spaces, since these tend to assist in code breaking, and although it could have been further restricted to just capital letters, it was decided that adding integers would make it more useful. The code is intended for Microsoft Excel, but is easily adapted to work in other MS Office products that run VBA. For example, to run it in MS Word, the results will still display in the message box, but it will be necessary to comment-out all lines, (put an apostrophe before each), of the '''output to sheet 1'' and ''make columns fit sections''. Figure 1 shows the Vigenere table without integers or other characters. Figure 2, the basis for the coding, shows a similar table that includes integers and capitals, and no other characters. The Vigenere cipher makes use of a repeated keyword or phrase. That is to say, the key string is repeated as often as necessary to cover the message, prior to working. This can be seen in the example of Figure 1, where the very short key "BULGE" was extended to "BULGEBUL" to cover the eight characters of the message. Clearly, the extension of the key in this way avoids any fixed relationship in the encryption, especially when more complex keys are used. A very good description of the "Key Elimination" method for cracking such simplistic keys can be found in Vigenere Cipher. The coded version of the cipher uses a calculation to simulate the tabular method. The twenty-six letters of the alphabet and the ten integers are assigned number values between zero and thirty-five. Then, for encryption, key values are modulo-36 added to message values to make the ciphertext. For decryption, key values are subtracted from the ciphertext, again using modulo-36 arithmetic, and always producing positive values. Numbers are converted back to characters for display. Notes on the Code thumb|right|450px|Figure 1: The Vigenere cipher uses the intersection of table entries for encryption and a reverse lookup for decryption. Notice in this example that the two instances of the letter E were encrypted differently. The extended table that is the basis of the coding however, can be found in Figure 2. No userform is provided. Instead, type message and key strings, and the boolean value for the working mode, into the top procedure directly. Interested parties might well add a user form of their own. CheckInputs() makes sure that no illegal characters are included, while procedure LongKey() makes a key value equal in length to the message. CharaToMod36() converts each string character, of both message and key, to its set-position number. Another procedure, Mod36ToChara() converts these numbers back again prior to display. AddMod36() performs modulo-36 addition, and subtracts 36 from numbers larger than 35 to keep the result within the set. The procedure SubMod36() performs subtraction, and adds 36 to any negative results, again, to keep the numbers within range. There is some latitude for improvement of the code. For example, the set could be further extended, and the key could be tested to avoid some of the flaws that are characteristic of this cipher. At present, the user must interpret the position for spaces in the decrypted results; this helps to better conceal the use of the frequently used space character. So, extend the set only at the risk of worsened performance. As mentioned before, a user form could be made to replace direct entry. Because repeat patterns can develop, some care is needed in coding. Clearly, a key that consists only of one repeated character would not be very secure, especially if it were the letter A. (Try it!). A good mixture of characters makes for the best key, and if the key completely covers the message without repetition, so much the better. This latter situation helps to avoid patterns that might make for easier cracking. In fact, if instead of a repeated key, a hash of the key were used, many of these pattern weaknesses might be avoided. Those who have an interest in such modifications will find hash procedures elsewhere in this series; (use base64 output). That said, care should be taken to include only alpha characters and integers from any such hash, or errors will result. (B64 strings from hash algorithms typically have three additional symbol characters to avoid, =, +, and /. ) A Larger Vigenere Table 450px center Figure 2: Vigenere Cipher Table with Capitals and Integers center|600px If all else fails, and for those who prefer manual working anyway, the table in the above drop-box may be found useful. It lists both capitals and integers. Notice that although both tables have a passing similarity, their content is quite different in places, so they are not fully interchangeable. A Worked Example The following panel shows how the calculation works for the coded version. It is analogous to the adding and subtraction of character distances within a closed set. Other implementations of the manual method have included the sliding of one set of characters against another for the required distances, sometimes using concentric discs. Figure 2 can be interpreted as a listing of every possible combination of messages and keys. THE CHARACTER SET AND ITS VALUES A B C D E F G H I J K L M 0 1 2 3 4 5 6 7 8 9 10 11 12 N O P Q R S T U V W X Y Z 13 14 15 16 17 18 19 20 21 22 23 24 25 0 1 2 3 4 5 6 7 8 9 26 27 28 29 30 31 32 33 34 35 ENCRYPTION WORKING S E N D H E L P message (1) B U L G E key B U L G E B U L extended key (2) 18 4 13 3 7 4 11 15 message values (3) 1 20 11 6 4 1 20 11 key values (4) 19 24 24 9 11 5 31 26 (3)+(4) (5) T Y Y J L F 5 0 cipher text (Note 1) (7) Note 1: Subtract 36 from any numbers here that might exceed 35. Notice that each instance of "E" results in different cipher text. DECRYPTION WORKING T Y Y J L F 5 0 cipher text (8) B U L G E key B U L G E B U L extended key (9) 19 24 24 9 11 5 31 26 cipher text values (10) 1 20 11 6 4 1 20 11 key values (11) 18 4 13 3 7 4 11 15 (10) minus (11) (12) S E N D H E L P plain text (Note 2) (15) Note 2: Add 36 to any numbers here that might become negative. The VBA Code Module Copy this entire code listing into an Excel standard module, save the file as a xlsm type, then run the top procedure. No user form code has been provided, so the user should enter his message (sTxt) and key (sKey) strings directly into the section identified in the top procedure. Be sure to identify whether encryption or decryption is intended with the setting of the variable bEncrypt. Corrections: 6 April 2020; corrected a note in SubMod36(); does not affect operation. Option Explicit Sub EncryptDecrypt() 'Run this procedure for a simple Vigenere encryption/decryption 'Capital letters and integers only; no symbols; no spaces.(ie: mod36 working). 'Set message, key and mode directly in this procedure before running it. 'Output to a message box and Excel. Overwrites some cells in Sheet1. Dim vA() As String, oSht As Worksheet Dim nM As Long, c As Long Dim sTxt As String, sK As String Dim sKey As String, sMode As String, sAccum As String Dim bEncrypt As Boolean, bMOK As Boolean, bKOK As Boolean Set oSht = ThisWorkbook.Worksheets("Sheet1") 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX '-------------------------USER ADDS DATA HERE------------------------ 'user should enter texts and encrypt/decrypt choice here sTxt = "2019forthecup" 'text to process, plain or cipher sKey = "BOGEYMAN" 'Key word or phrase bEncrypt = True 'set True for encrypt; False for decrypt '--------------------------------------------------------------------- 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'convert both strings to upper case sTxt = UCase(sTxt) sKey = UCase(sKey) 'check the message and key for illegal characters 'restricted here to capital letters and integers only bMOK = CheckInputs(sTxt) bKOK = CheckInputs(sKey) If bMOK = False Or bKOK = False Then If sTxt <> "" And sKey <> "" Then MsgBox "Illegal characters found." Else MsgBox "Empty strings found." End If Exit Sub End If 'make an extended key to match the message length nM = Len(sTxt) sKey = LongKey(sKey, nM) 'dimension a work array equal in length to the message ReDim vA(1 To 10, 1 To nM) '10 rows and nM columns 'read the message, key, and mod-36 values into array For c = LBound(vA, 2) To UBound(vA, 2) 'r,c 'text chara by chara vA(1, c) = CStr(Mid$(sTxt, c, 1)) 'message charas vA(2, c) = CStr(Mid$(sKey, c, 1)) 'key charas 'text's converted number values vA(3, c) = CStr(CharaToMod36(Mid$(sTxt, c, 1))) 'number values of charas vA(4, c) = CStr(CharaToMod36(Mid$(sKey, c, 1))) 'number values of charas Next c 'steer code for encrypt or decrypt If bEncrypt = True Then 'encrypt sMode = " : Encryption result" 'display string GoTo ENCRYPT Else sMode = " : Decryption result" 'display string GoTo DECRYPT End If ENCRYPT: 'sum of converted key and message values mod-36 'then find string character values of sums For c = LBound(vA, 2) To UBound(vA, 2) vA(5, c) = CStr(AddMod36(CLng(vA(3, c)), CLng(vA(4, c)))) vA(6, c) = Mod36ToChara(CLng(vA(5, c))) Next c 'accumulate the encrypted charas into a single display string 'for message box and worksheet For c = LBound(vA, 2) To UBound(vA, 2) sAccum = sAccum & vA(6, c) 'mixed Next c GoTo DISPLAY DECRYPT: 'subtract key values from encrypted chara values 'and make negative values positive by adding 36 'Find string character values of the differences For c = LBound(vA, 2) To UBound(vA, 2) vA(5, c) = CStr(SubMod36(CLng(vA(3, c)), CLng(vA(4, c)))) vA(6, c) = Mod36ToChara(CLng(vA(5, c))) Next c 'accumulate the encrypted charas into a display string 'for message box and worksheet For c = LBound(vA, 2) To UBound(vA, 2) sAccum = sAccum & vA(6, c) 'mixed Next c GoTo DISPLAY DISPLAY: 'message box display MsgBox sTxt & " : Text to Process" & vbCrLf & _ sKey & " : Extended Key" & vbCrLf & _ sAccum & sMode 'and output to sheet1 in monospaced font With oSht .Cells(1, 1).Value = sTxt .Cells(1, 2).Value = " : Text to Process" .Cells(2, 1).Value = sKey .Cells(2, 2).Value = " : Extended Key" .Cells(3, 1).Value = sAccum .Cells(3, 2).Value = sMode .Cells.Font.Name = "Consolas" .Columns("A:A").Select End With 'make columns fit text length Selection.Columns.AutoFit oSht.Cells(1, 1).Select End Sub Function CheckInputs(sText As String) As Boolean 'checks message and key for illegal characters 'here intends use of capitals A-Z, ie ASCII 65-90 'and integers 0-9, ie ASCII 48-57 Dim nL As Long, n As Long Dim sSamp As String, nChr As Long 'check for empty strings If sText = "" Then MsgBox "Empty parameter string - closing" Exit Function End If 'test each character nL = Len(sText) For n = 1 To nL 'get characters one by one sSamp = Mid$(sText, n, 1) 'convert to ascii value nChr = Asc(sSamp) 'filter Select Case nChr Case 65 To 90, 48 To 57 'these are ok Case Else MsgBox "Illegal character" & vbCrLf & _ "Only capital letters and integers are allowed; no symbols and no spaces" Exit Function End Select Next n CheckInputs = True End Function Function LongKey(sKey As String, nLM As Long) As String 'makes a repeated key to match length of message 'starting from the user's key string 'used in both encryption and decryption Dim nLK As Long, n As Long, m As Long Dim p As Long, sAccum As String 'make long key nLK = Len(sKey) 'if key is longer than message If nLK >= nLM Then LongKey = Left$(sKey, nLM) 'trim key to fit Exit Function Else 'message is assumed longer than key n = Int(nLM / nLK) 'number of repeats needed m = nLM - (n * nLK) 'number of additional characters For p = 1 To n sAccum = sAccum & sKey Next p sAccum = sAccum & Left$(sKey, m) 'add any end characters End If LongKey = sAccum End Function Function CharaToMod36(sC As String) As Long 'gets the modulo-36 value of the input character 'as it exists in the working set 'For example range A to Z becomes 0 to 25 'and 0 to 9 become 26 to 35 Dim nASC As Long 'get ascii value of character nASC = Asc(sC) 'align charas to working set Select Case nASC Case 65 To 90 'subtract 65 to convert to zero based set CharaToMod36 = nASC - 65 Case 48 To 57 'subtract 22 to convert to zero based set CharaToMod36 = nASC - 22 End Select End Function Function Mod36ToChara(nR As Long) As String 'gets the character for a mod-36 value 'For example range 0 to 25 becomes A to Z 'and 26 to 35 become 0 to 9 Select Case nR Case 0 To 25 'cap letters, A-Z Mod36ToChara = Chr(nR + 65) Case 26 To 35 'integers, 0-9 Mod36ToChara = Chr(nR + 22) Case Else MsgBox "Illegal character in Mod36ToChara" Exit Function End Select End Function Function AddMod36(nT As Long, nB As Long) As Long 'adds two positive integers to mod-36, ie set 0-35, 'that is, no output can exceed 35 Dim nSum As Long If nT >= 0 And nT < 36 And nB >= 0 And nB < 36 Then 'inputs are all ok Else MsgBox "Parameters out of bounds in AddMod36" End If nSum = nT + nB AddMod36 = nSum Mod 36 End Function Function SubMod36(nT As Long, nB As Long) As Long 'subtracts nB from nT mod-36 'that is, no output can be negative or exceed 35 'Returns negative results as positive by adding 36 Dim nDif As Long If nT >= 0 And nT < 36 And nB >= 0 And nB < 36 Then 'inputs are all ok Else MsgBox "Parameters out of bounds in SubMod36" End If nDif = nT - nB 'possibly negative If nDif < 0 Then nDif = nDif + 36 End If SubMod36 = nDif End Function Sub Notes() 'Notes on the code 'A to Z, correspond to character set positions 0 to 25. '0 to 9, correspond to character set positions 26 to 35. 'The modulus for addition and subtraction is therefore 36. 'Negative results in calculation are made positive by adding 36. 'Positive results in calculation greater than 35 are reduced by 36. 'ASCI values made calculation simple here but a more general version could 'preload any character set for lookup with alternative coding. 'See Wikibooks text for a table image and further details. End Sub See Also