'**************************************
'Windows API/Global Declarations for :Fa
' st 64bit RSA Encryption Algorithm
'**************************************
Public key(1 To 3) As Double
Public p As Double, q As Double
Public PHI As Double
Public Sub keyGen()
'Generates the keys for E, D and N
Dim E#, D#, N#
Const PQ_UP As Integer = 9999 'set upper limit of random number
Const PQ_LW As Integer = 3170 'set lower limit of random number
Const KEY_LOWER_LIMIT As Long = 10000000 'set for 64bit minimum
p = 0: q = 0
Randomize
Do Until D > KEY_LOWER_LIMIT 'makes sure keys are 64bit minimum
Do Until IsPrime(p) And IsPrime(q) ' make sure q and q are primes
p = Int((PQ_UP - PQ_LW + 1) * Rnd + PQ_LW)
q = Int((PQ_UP - PQ_LW + 1) * Rnd + PQ_LW)
Loop
N = p * q
PHI = (p - 1) * (q - 1)
E = GCD(PHI)
D = Euler(E, PHI)
Loop
key(1) = E
key(2) = D
key(3) = N
End Sub
Private Function Euler(E3 As Double, PHI3 As Double) As Double
'genetates D from (E and PHI) using the
' Euler algorithm
On Error Resume Next
Dim u1#, u2#, u3#, v1#, v2#, v3#, q#
Dim t1#, t2#, t3#, z#, uu#, vv#, inverse#
u1 = 1
u2 = 0
u3 = PHI3
v1 = 0
v2 = 1
v3 = E3
Do Until (v3 = 0)
q = Int(u3 / v3)
t1 = u1 - q * v1
t2 = u2 - q * v2
t3 = u3 - q * v3
u1 = v1
u2 = v2
u3 = v3
v1 = t1
v2 = t2
v3 = t3
z = 1
Loop
uu = u1
vv = u2
If (vv < 0) Then
inverse = vv + PHI3
Else
inverse = vv
End If
Euler = inverse
End Function
Private Function GCD(nPHI As Double) As Double
'generates a random number relatively pr
' ime to PHI
On Error Resume Next
Dim nE#, y#
Const N_UP = 99999999 'set upper limit of random number for E
Const N_LW = 10000000 'set lower limit of random number for E
Randomize
nE = Int((N_UP - N_LW + 1) * Rnd + N_LW)
top:
x = nPHI Mod nE
y = x Mod nE
If y <> 0 And IsPrime(nE) Then
GCD = nE
Exit Function
Else
nE = nE + 1
End If
GoTo top
End Function
Private Function IsPrime(lngNumber As Double) As Boolean
'Returns 'True' if lngNumber is a prime
On Error Resume Next
Dim lngCount#
Dim lngSqr#
Dim x#
lngSqr = Int(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 Function
Public Function Mult(ByVal x As Double, ByVal p As Double, ByVal m As Double) As Double
'encrypts, decrypts values passed to the
' function.. e.g.
'Mult = M^E mod N (encrypt) where M = x
' , E = p, N = m
'Mult = M^D mod N (decrypt)
On Error GoTo error1
y = 1
Do While p > 0
Do While (p / 2) = Int((p / 2))
x = nMod((x * x), m)
p = p / 2
Loop
y = nMod((x * y), m)
p = p - 1
Loop
Mult = y
Exit Function
error1:
y = 0
End Function
Private Function nMod(x As Double, y As Double) As Double
'this function replaces the Mod command.
' instead of z = x Mod y
'it is now z = nMod(x,y)
On Error Resume Next
Dim z#
z = x - (Int(x / y) * y)
nMod = z
End Function
Public Function enc(tIp As String, eE As Double, eN As Double) As String
'returns the long value of the character
' s, chained with a +
'e.g. 12345678+23456789+ etc..
'**Taken out encryption algorithm to sim
' plify program**
On Error Resume Next
Dim encSt As String
encSt = ""
e2st = ""
If tIp = "" Then Exit Function
For i = 1 To Len(tIp)
encSt = encSt & Mult(CLng(Asc(Mid(tIp, i, 1))), eE, eN) & "+"
Next i
'** put your encryption algorithm code h
' ere **
enc = encSt
End Function
Public Function dec(tIp As String, dD As Double, dN As Double) As String
'returns the characters from the long va
' lues
'e.g A = 12345678, B = 23456789 etc..
'**Taken out decryption algorithm to sim
' plify program**
On Error Resume Next
Dim decSt As String
decSt = ""
'** put your decryption algorithm code h
' ere **
For z = 1 To Len(tIp)
ptr = InStr(z, tIp, "+")
tok = Val(Mid(tIp, z, ptr))
decSt = decSt + Chr(Mult(tok, dD, dN))
z = ptr
Next z
dec = decSt
End Function
Public key(1 To 3) As Double
Сейчас этот форум просматривают: Google-бот и гости: 210