반응형
RSA Encryption with Excel Part 1.
RSA_example_screencast.xlsx
0.04MB
RSA Encryption with Excel Part 2.
RSA Encryption with Excel Part 3.
Encryption of Confidential Numbers in Excel
http://exceldevelopmentplatform.blogspot.com/2017/07/cryptography-vba-code-for-wikipedias.html
Cryptography - VBA code for Wikipedia's RSA example
So, following on from studying some cryptography I can give some VBA code which implements RSA or at least the example given on the RSA Wik...
exceldevelopmentplatform.blogspot.com
Option Explicit
Option Private Module
Private Type udtPublicKey
n As Currency
e As Currency
End Type
Private Type udtPrivateKey
n As Currency
d As Currency
End Type
'***************************************************
' .__
' _____ _____ |__| ____
' / \\__ \ | |/ \
'| Y Y \/ __ \| | | \
'|__|_| (____ /__|___| /
' \/ \/ \/
'***************************************************
Private Sub Main()
Dim p As Currency
Dim q As Currency
Dim n As Currency
Dim lambda_n As Currency
Dim e As Currency
Dim d As Currency
p = 61
q = 53
n = p * q
lambda_n = Application.Lcm(p - 1, q - 1)
e = 17
Debug.Assert IsCoPrime(e, lambda_n)
d = ModularMultiplicativeInverse(e, lambda_n)
Debug.Assert e <> d
Dim uPrivate As udtPrivateKey
uPrivate.d = d
uPrivate.n = n
Dim uPublic As udtPublicKey
uPublic.e = e
uPublic.n = n
'* m is the message to encrypt, it needs to be a number
'* 65 is ASCII for "A"
Dim m As Currency
m = 65
'* c is the encrypted message
Dim c As Currency
c = Encrypt(m, uPublic)
'* m2 is the decrypted message
Dim m2 As Currency
m2 = Decrypt(c, uPrivate)
'* and the decrypted message should match the original
Debug.Assert m2 = m
End Sub
Private Function Encrypt(ByVal m As Currency, _
ByRef uPublic As udtPublicKey) As Currency
If m > uPublic.n Then Err.Raise vbObjectError, , _
"#text is bigger than modulus, no way to decipher!"
Dim lLoop As Long
Dim lResult As Currency
lResult = 1
For lLoop = 1 To uPublic.e
lResult = ((lResult Mod uPublic.n) * (m Mod uPublic.n)) Mod uPublic.n
Next lLoop
Encrypt = lResult
End Function
Private Function Decrypt(ByVal c As Currency, _
ByRef uPrivate As udtPrivateKey) As Currency
If c > uPrivate.n Then Err.Raise vbObjectError, , _
"#text is bigger than modulus, no way to decipher!"
Dim lLoop As Long
Dim lResult As Currency
lResult = 1
For lLoop = 1 To uPrivate.d
lResult = ((lResult Mod uPrivate.n) * (c Mod uPrivate.n)) Mod uPrivate.n
Next lLoop
Decrypt = lResult
End Function
Private Function IsCoPrime(ByVal a As Currency, ByVal b As Currency) As Boolean
IsCoPrime = (Application.Gcd(a, b) = 1)
End Function
Private Function ModularMultiplicativeInverse(ByVal e As Currency, _
ByVal lambda_n As Currency)
Dim lLoop As Currency
For lLoop = 1 To lambda_n
If lLoop <> e Then
Dim lComp As Currency
lComp = lLoop * e Mod lambda_n
If lComp = 1 Then
ModularMultiplicativeInverse = lLoop
Exit Function
End If
End If
Next
SingleExit:
End Function
https://gist.github.com/ooltcloud/f9b3d1f933d3d0b13cf6
Sub Main()
' 鍵生成
Call GetKey(publicKey, privateKey)
Debug.Print publicKey
Debug.Print privateKey
' 暗号化
encryptString = Encrypt(publicKey, "あいう")
Debug.Print encryptString
' 復号
planeString = Decrypt(privateKey, encryptString)
Debug.Print planeString & "*"
End Sub
' 鍵生成
Sub GetKey(publicKey, privateKey)
Set rsa = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider")
publicKey = rsa.ToXmlString(False)
privateKey = rsa.ToXmlString(True)
End Sub
' 暗号化
Function Encrypt(key, value) As String
Set rsa = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider")
' 文字列を Byte 列に (UTF-16)
Dim byteString() As Byte
byteString = value
' 暗号化
Call rsa.FromXmlString(key)
encryptData = rsa.Encrypt(byteString, False)
' 暗号 Byte 列 を文字列 に
encryptString = ""
For Each v In encryptData
encryptString = encryptString & Right("00" & Hex(v), 2)
Next
' return
Encrypt = encryptString
End Function
' 復号
Function Decrypt(key, value) As String
Set rsa = CreateObject("System.Security.Cryptography.RSACryptoServiceProvider")
' 文字列を Byte 列 に
byteLength = Len(value) \ 2
Dim encryptData() As Byte
ReDim encryptData(byteLength - 1)
For i = 0 To byteLength - 1
encryptData(i) = CByte("&H" & Mid(value, i * 2 + 1, 2))
Next
' 復号
Call rsa.FromXmlString(key)
planeData = rsa.Decrypt(encryptData, False)
' return
Decrypt = planeData
End Function반응형
'VBA' 카테고리의 다른 글
| #NAME? 오류가 발생하는 원인과 해결 방법 (0) | 2023.01.12 |
|---|---|
| 닫힌 다각형의 내부점인지 외부점인지 확인하는 방법 (0) | 2023.01.12 |
| 하이퍼링크 일괄삭제 (0) | 2022.08.04 |
| Maclauric Seires for Exp(x) (0) | 2022.07.12 |
| Excel VBA Dictionary (0) | 2022.06.21 |
