psc1.bas

此程序采用了psc1算法来实现快速的RSA加密):

Attribute VB_Name = "PSC1"
Public N As Long

Public PrvI As Long
Public PubI As Long

Public Prv As Long
Public Pub As Long

Public ValueIndex As Long

Sub GenKey(ByVal NMin As Long, ByVal NMax As Long)

Dim tPub As Long

Randomize

Top:

N = Int((NMax * Rnd) + NMax)
Prv = RndPrime(1, N)
Pub = Int((N * Rnd) + 1)

tPub = Pub
Do Until Pub * Prv Mod N = 1
   Pub = Pub + 1
   If Pub = tPub Then GoTo Top
   If Pub > N Then Pub = 1
Loop

PrvI = 1
PubI = N - PrvI
ValueIndex = 1

End Sub

Function RndPrime(Min As Long, Max As Long) As Long

LoopBig:
    
    RndPrime = Int((Max * Rnd) + Min)

loopSmall:
    
    RndPrime = RndPrime + 1
    If RndPrime > Max Then GoTo LoopBig
    If IsPrime(RndPrime) = False Then GoTo loopSmall
    If RndPrime = 0 Or RndPrime = 1 Then GoTo LoopBig

End Function

Private Function IsPrime(lngNumber) As Boolean

Dim lngCount As Long
Dim lngSqr As Long
Dim X As Long
lngSqr = Sqr(lngNumber)

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 Function

Function Encrypt(M As Long) As Long

    Encrypt = ((M + PubI) * Pub) Mod N
    PubI = (PubI * (ValueIndex * M + 1)) Mod N
    
End Function

Function Decrypt(C As Long) As Long

    Decrypt = ((C * Prv) + PrvI) Mod N
    PrvI = (PrvI * (ValueIndex * Decrypt + 1)) Mod N
   
    ValueIndex = ValueIndex Mod N

End Function

Function EncryptBt(B As String) As String

    EncryptBt = Hex(Encrypt(Asc(Mid(B, 1, 1))))

End Function

Function DecryptBt(B As String) As String

    DecryptBt = Chr(Decrypt(Val("&H" + B)))

End Function

Function EncryptBk(Block As String) As String

Dim Length As Long
Dim iDX As Long

Length = Len(Block) + 1
iDX = 1
EncryptBk = ""

Do Until iDX = Length
    
    EncryptBk = EncryptBk + EncryptBt(Mid(Block, iDX, 1)) + " "
    iDX = iDX + 1

Loop

End Function

Function DecryptBk(Block As String) As String

Dim Temp As String
Dim iDX As Long

Temp = Block
iDX = 1
DecryptBk = ""


Do Until InStr(1, Temp, " ") = 0

    DecryptBk = DecryptBk + DecryptBt(Mid(Temp, 1, InStr(1, Temp, " ")))
    Temp = Mid(Temp, InStr(1, Temp, " ") + 1, Len(Temp) - InStr(1, Temp, " "))
    iDX = iDX + 1

Loop

End Function