014集——RSA非对称加密——vba源代码

 今天介绍一种安全的加密方法，RSA非对称加密。

RSA算法基于一个十分简单的数论事实:将两个大质数相乘十分容易，但是想要对其乘积进行因式分解却极其困难，因此可以将乘积公开作为加密密钥。

部分源代码如下：

'qq443440204@2024年3月30日15:39:48
'RSA加密解密类
'############ 属性 ##############
'公钥e      Long    \
'通钥n      Long     > 由GenKey产生
'私钥d      Long    /
'############ 方法 ##############
'GenKey     Null    产生钥匙
'IsPrime    Y/N     是否是素数
'Mult       Long    单个数据的加密解密运算
'Encode     String 批量加密运算
'Decode     String 批量解密运算

'Option Explicit

Public 公钥e As Long, 私钥d As Long, 通钥n As Long
Private Const base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Function CPU序列号(ByVal mycs As String) As String
'特别提示：这个不是唯一的，即有可能多个CPU同一一序列号
For Each 序列 In GetObject("Winmgmts:").InstancesOf("Win32_Processor")
CPU序列号 = Len(mycs) & CPU序列号 & CStr(序列.ProcessorId) & mycs
Next
End Function
'//##### 批量加密运算函数 #####
Public Function Encode(ByVal Inp As String, ByVal e As Long, ByVal n As Long) As String
Dim s As String
s = ""
If Inp = "" Then Exit Function
s = Mult(CLng(Asc(Mid(Inp, 1, 1))), e, n)
For i = 2 To Len(Inp)
s = s & "+" & Mult(CLng(Asc(Mid(Inp, i, 1))), e, n)
Next i
Encode = Base64_Encode(s)
End Function


'//##### 批量解密运算函数 #####
Public Function Decode(ByVal Inp As String, ByVal d As Long, ByVal n As Long) As String
St = ""
ind = Base64_Decode(Inp)
For i = 1 To Len(ind)
nxt = InStr(i, ind, "+")
If Not nxt = 0 Then
tok = Val(Mid(ind, i, nxt))
Else
tok = Val(Mid(ind, i))
End If
St = St + Chr(Mult(CLng(tok), d, n))
If Not nxt = 0 Then
i = nxt
Else
i = Len(ind)
End If
Next i
Decode = St
End Function


'//##### 产生钥匙 #####
Public Function GenKey(Optional MinN As Long)
Dim d As Long, phi As Long, e As Long
Dim m As Long, x As Long, q As Long
Dim p As Long
Randomize
On Error GoTo top
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''
'''''''''''''
'''''''''''''完整代码联系本博
'''''''''''''
'''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'//##### 解密为原来的数据 #####
Private Function Base64_Decode(a As String) As String
Dim w1 As Integer
Dim w2 As Integer
Dim w3 As Integer
Dim w4 As Integer
Dim n As Integer
Dim retry As String

   For n = 1 To Len(a) Step 4
w1 = mimedecode(Mid$(a, n, 1))
w2 = mimedecode(Mid$(a, n + 1, 1))
w3 = mimedecode(Mid$(a, n + 2, 1))
w4 = mimedecode(Mid$(a, n + 3, 1))
If w2 >= 0 Then retry = retry + Chr$(((w1 * 4 + Int(w2 / 16)) And 255))
If w3 >= 0 Then retry = retry + Chr$(((w2 * 16 + Int(w3 / 4)) And 255))
If w4 >= 0 Then retry = retry + Chr$(((w3 * 64 + w4) And 255))
Next
Base64_Decode = retry
End Function

Private Function mimedecode(a As String) As Integer
If Len(a) = 0 Then mimedecode = -1: Exit Function
mimedecode = InStr(base64, a) - 1
End Function

Private Function mimeencode(w As Integer) As String
If w >= 0 Then mimeencode = Mid$(base64, w + 1, 1) Else mimeencode = ""
End Function
Sub a()
mykey = GenKey(2)
mystring = CPU序列号("cs")
注册码 = Encode(mystring, 公钥e, 通钥n)
解码 = Decode(注册码, 私钥d, 通钥n)
Stop
End Sub

以上即为加密解密vba代码。