Visual Basic for Applications/Simple Vigenere Cipher in VBA
Summary
edit- 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
edit
- 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
edit
|
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
editThe 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
editCopy 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