经典加密算法在VB中的实现：Base64

　Public key(1 To 3) As Long
　　Private Const base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrst
　　uvwxyz0123456789+/"
　　Public 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
　　Private 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
　　Private Function Mult(ByVal x As Long, ByVal p As Long, ByVal m As Lon
　　g) 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
　　Private 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
　　End If
　　lngCount = 2
　　IsPrime = True
　　If lngNumber Mod lngCount = 0& Then
　　IsPrime = False
　　Exit Function
　　End If
　　lngCount = 3
　　For x& = lngCount To lngSqr Step 2
　　If lngNumber Mod x& = 0 Then
　　IsPrime = False
　　Exit Function
　　End If
　　Next
　　End FunctionPrivate Function Base64_Encode(DecryptedText As String) As String
　　Dim c1, c2, c3 As Integer
　　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(DecryptedText) Step 3
　　c1 = Asc(Mid$(DecryptedText, n, 1))
　　c2 = Asc(Mid$(DecryptedText, n + 1, 1) + Chr$(0))
　　c3 = Asc(Mid$(DecryptedText, n + 2, 1) + Chr$(0))
　　w1 = Int(c1 / 4)
　　w2 = (c1 And 3) * 16 + Int(c2 / 16)
　　If Len(DecryptedText) >= n + 1 Then w3 = (c2 And 15) * 4 + Int(c
　　3 / 64) Else w3 = -1
　　If Len(DecryptedText) >= n + 2 Then w4 = c3 And 63 Else w4 = -1
　　retry = retry + mimeencode(w1) + mimeencode(w2) + mimeencode(w3)
　　+ mimeencode(w4)
　　Next
　　Base64_Encode = retry
　　End Function
　　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)) An
　　d 255))
　　If w3 >= 0 Then retry = retry + Chr$(((w2 * 16 + Int(w3 / 4)) An
　　d 255))
　　If w4 >= 0 Then retry = retry + Chr$(((w3 * 64 + w4) And 255))
　　Next
　　Base64_Decode = retry
　　End Function
　Private Function mimeencode(w As Integer) As String
　　If w >= 0 Then mimeencode = Mid$(base64, w + 1, 1) Else mimeencode
　　= ""
　　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
　　Public Function Encode(ByVal Inp As String, ByVal e As Long, ByVal n A
　　s Long) As String
　　Dim s As String
　　s = ""
　　m = Inp
　　If m = "" Then Exit Function
　　s = Mult(CLng(Asc(Mid(m, 1, 1))), e, n)
　　For i = 2 To Len(m)
　　s = s & "+" & Mult(CLng(Asc(Mid(m, 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 A
　　s 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