Attribute VB_Name = "ModBase64"
Option Explicit
Public key(1 To 3) As Long
Private Const base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Public Sub GenKey()Sub GenKey()
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
top:
p = Rnd * 1000 1
If IsPrime(p) = False Then GoTo top
Sel_q:
q = Rnd * 1000 1
If IsPrime(q) = False Then GoTo Sel_q
n = p * q 1
phi = (p - 1) * (q - 1) 1
d = Rnd * n 1
If d = 0 Or n = 0 Or d = 1 Then GoTo top
e = Euler(phi, d)
If e = 0 Or e = 1 Then GoTo top
x = Mult(255, e, n)
If Not Mult(x, d, n) = 255 Then
DoEvents
GoTo top
ElseIf Mult(x, d, n) = 255 Then
key(1) = e
key(2) = d
key(3) = n
End If
End Sub
Public Function Euler()Function Euler(ByVal a As Long, ByVal b As Long) As Long
On Error GoTo error2
r1 = a: r = b
p1 = 0: p = 1
q1 = 2: q = 0
n = -1
Do Until r = 0
r2 = r1: r1 = r
p2 = p1: p1 = p
q2 = q1: q1 = q
n = n + 1
r = r2 Mod r1
c = r2 r1
p = (c * p1) + p2
q = (c * q1) + q2
Loop
s = (b * p1) - (a * q1)
If s > 0 Then
x = p1
Else
x = (0 - p1) + a
End If
Euler = x
Exit Function
error2:
Euler = 0
End Function
Public Function Mult()Function Mult(ByVal x As Long, ByVal p As Long, ByVal m As Long) As Long
y = 1
On Error GoTo error1
Do While p > 0
Do While (p / 2) = (p 2)
x = (x * x) Mod m
p = p / 2
Loop
y = (x * y) Mod m
p = p - 1
Loop
Mult = y
Exit Function
error1:
y = 0
End Function
Public Function IsPrime()Function IsPrime(lngNumber As Long) As Boolean
Dim lngCount As Long
Dim lngSqr As Long
Dim x As Long
lngSqr = Sqr(lngNumber) ’’ get the int square root
If lngNumber < 2 Then
IsPrime = False
Exit Function
责任编辑：小草
