VBBase64編碼類代碼

字號:

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