应用程序/简单Vigenere密码在VBA
< 应用程序
- 这个VBA代码模块运行16世纪的Vigenere密码。它用于隐藏消息内容，可能用于短期军事信息。该方法是早期尝试掩盖通信中使用的语言的自然频率的例子。发送方和接收方共享一个秘密单词或短语，即所谓的密钥，用于对消息进行加密和解密。代码不包含空格，因为这些空格往往有助于破解代码，尽管它可以进一步限制为仅大写字母，但决定添加整数将使其更有用。
- 该代码适用于Microsoft Excel，但可以轻松地修改为在运行VBA的其他MS Office产品中使用。例如，要让它在MS Word中运行，结果仍然会显示在消息框中，但需要将所有代码行注释掉（在每个代码行前添加一个单引号），即“输出到工作表1”和“使列适合部分”。
- 图1显示了没有整数或其他字符的Vigenere表格。图2是编码的基础，显示了包含整数和大写字母，不包含其他字符的类似表格。
- Vigenere密码使用重复的关键字或短语。也就是说，密钥字符串被重复多次，以覆盖消息，然后再进行处理。这可以在图1的例子中看到，其中很短的密钥“BULGE”被扩展为“BULGEBUL”以覆盖消息的8个字符。显然，以这种方式扩展密钥避免了加密中的任何固定关系，特别是在使用更复杂的密钥时。在Vigenere密码中可以找到破解这种简单密钥的“密钥消除”方法的非常好的描述。
- 密码的编码版本使用计算来模拟表格方法。字母表的26个字母和10个整数被分配从零到35的数字值。然后，在加密时，密钥值被模36加到消息值以构成密文。在解密时，密钥值从密文中减去，同样使用模36运算，并始终产生正值。数字在显示前被转换回字符。
- 没有提供用户表单。相反，在顶层过程中直接输入消息和密钥字符串，以及工作模式的布尔值。有兴趣的人可能还会添加他们自己的用户表单。
- CheckInputs()确保不包含任何非法字符，而过程LongKey()使密钥值等于消息的长度。
- CharaToMod36()将消息和密钥的每个字符串字符转换为其集合位置编号。另一个过程Mod36ToChara()在显示之前将这些数字转换回来。
- AddMod36()执行模36加法，并将大于35的数字减去36，以使结果保持在集合中。过程SubMod36()执行减法，并加上36到任何负结果，同样地，使数字保持在范围内。
- 代码有一些改进的空间。例如，可以进一步扩展集合，并且可以测试密钥以避免此密码特有的某些缺陷。目前，用户必须解释解密结果中空格的位置；这有助于更好地隐藏常用空格字符的使用。所以，扩展集合只有在性能下降的风险下进行。如前所述，可以使用用户表单来替代直接输入。
- 因为可能会产生重复模式，所以编码时需要小心。显然，仅由一个重复字符组成的密钥并不安全，尤其是如果它是字母A。（试试看！）。良好的字符混合构成最好的密钥，如果密钥完全覆盖消息并且没有重复，那就更好了。这种情况有助于避免可能导致更容易破解的模式。事实上，如果使用哈希代替重复密钥，就可以避免许多这些模式弱点。那些对这种修改感兴趣的人可以在本系列的其他地方找到哈希过程；（使用base64输出）。也就是说，应该注意仅包含来自任何哈希的字母字符和整数，否则会导致错误。（来自哈希算法的B64字符串通常包含三个额外的符号字符需要避免，=、+ 和 /。）
|
如果其他方法都失败，对于那些仍然喜欢手动操作的人来说，上述下拉框中的表格可能会有用。它列出了大写字母和整数。请注意，尽管这两个表格在外观上相似，但它们的内容在某些地方却大不相同，因此它们不能完全互换。
以下面板显示了编码版本是如何计算的。它类似于在封闭集合中添加和减去字符距离。手动方法的其他实现包括将一组字符在另一组字符上滑动所需的距离，有时使用同心圆盘。图2可以解释为消息和密钥的所有可能组合的列表。
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.
将整个代码列表复制到Excel标准模块中，将文件保存为xlsm类型，然后运行顶层过程。没有提供用户表单代码，因此用户应直接在顶层过程中标识的部分中输入他的消息（sTxt）和密钥（sKey）字符串。确保通过设置变量bEncrypt来确定是加密还是解密。
更正
2020年4月6日；更正了SubMod36()中的一个注释；不影响操作。
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