请提供份RSA加密算法的VB源码

Question

最好好是有完整源码的

Answer 1

rem Simple RSA Program
rem (c) W.Buchanan
rem Jan 2002

Function check_prime(ByVal val As Long) As Boolean
Dim primes
primes = Array(1, 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97, 101, 103, 107, 109, 113, 127, 131, 137, 139, 149, 151, 157, 163, 167, 173, 179, 181, 191, 193, 197, 199, 211, 223, 227, 229, 233, 239, 241, 251, 257, 263, 269, 271, 277, 281, 283, 293, 307, 311, 313, 317, 331, 337, 347, 349, 353, 359, 367, 373, 379, 383, 389, 397)
check_prime = False

For i = 0 To 78
If (val = primes(i)) Then
prime = True
End If
Next i
check_prime = prime
End Function

Function decrypt(ByVal c, ByVal n, ByVal d As Long)

Dim i, g, f As Long

On Error GoTo errorhandler

If (d Mod 2 = 0) Then
g = 1
Else
g = c
End If

For i = 1 To d / 2

f = c * c Mod n
g = f * g Mod n
Next i
decrypt = g

Exit Function
errorhandler:
Select Case Err.Number ' Evaluate error number.
Case 6
status.Text = "Calculation overflow, please select smaller values"
Case Else
status.Text = "Calculation error"
End Select

End Function

Function getD(ByVal e As Long, ByVal PHI As Long) As Long
Dim u(3) As Long
Dim v(3) As Long
Dim q, temp1, temp2, temp3 As Long

u(0) = 1
u(1) = 0
u(2) = PHI
v(0) = 0
v(1) = 1
v(2) = e

While (v(2) <> 0)
q = Int(u(2) / v(2))
temp1 = u(0) - q * v(0)
temp2 = u(1) - q * v(1)
temp3 = u(2) - q * v(2)
u(0) = v(0)
u(1) = v(1)
u(2) = v(2)
v(0) = temp1
v(1) = temp2
v(2) = temp3
Wend
If (u(1) < 0) Then
getD = (u(1) + PHI)
Else
getD = u(1)
End If
End Function

Function getE(ByVal PHI As Long) As Long
Dim great, e As Long

great = 0
e = 2

While (great <> 1)
e = e + 1
great = get_common_denom(e, PHI)
Wend
getE = e
End Function

Function get_common_denom(ByVal e As Long, ByVal PHI As Long)
Dim great, temp, a As Long

If (e > PHI) Then
While (e Mod PHI <> 0)
temp = e Mod PHI
e = PHI
PHI = temp
Wend
great = PHI
Else
While (PHI Mod e <> 0)
a = PHI Mod e
PHI = e
e = a
Wend
great = e
End If
get_common_denom = great
End Function

Private Sub show_primes()
status.Text = "1"
no_primes = 1
For i = 2 To 400
prime = True
For j = 2 To (i / 2)
If ((i Mod j) = 0) Then
prime = False
End If
Next j

If (prime = True) Then
no_primes = no_primes + 1
status.Text = status.Text + ", " + Str(i)
End If
Next i
status.Text = status.Text + vbCrLf + "Number of primes found:" + Str(no_primes)
End Sub

Private Sub Command1_Click()
Dim p, q, n, e, PHI, d, m, c As Long

p = Text1.Text
q = Text2.Text
If (check_prime(p) = False) Then
status.Text = "p is not a prime or is too large, please re-enter"
ElseIf (check_prime(q) = False) Then
status.Text = "q is not a prime or is too large, please re-enter"
Else
n = p * q
Text3.Text = n

PHI = (p - 1) * (q - 1)
e = getE((PHI))
d = getD((e), (PHI))
Text4.Text = PHI
Text5.Text = d
Text6.Text = e
m = Text7.Text

c = (m ^ e) Mod n
Text8.Text = c
m = decrypt(c, n, d)
Text9.Text = m
Label12.Caption = "Decrypt key =<" + Str(d) + "," + Str(n) + ">"
Label13.Caption = "Encrypt key =<" + Str(e) + "," + Str(n) + ">"
End If
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Command3_Click()
frmBrowser.Show
End Sub

Private Sub Command4_Click()
Call show_primes
End Sub