應用程式/簡單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