vb和java base64_经典加密算法在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