winzip icon

Fast 64bit RSA Encryption Algorithm

Email
Submitted on: 1/5/2015 4:29:00 PM
By: William Gerard Griffiths (Author) (from psc cd)  
Level: Advanced
User Rating: By 8 Users
Compatibility: VB 4.0 (32-bit), VB 5.0, VB 6.0
Views: 2607
 
     The famous rsa public key encryption algorithm, this code is based on the original design by: Asgeir Bjarni Ingvarsson. Now includes source code and zip file with working example.
 

Windows API/Global Declarations:

Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
'**************************************
'Windows API/Global Declarations for :Fast 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 prime 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 characters, chained with a +
'e.g. 12345678+23456789+ etc..
'**Taken out encryption algorithm to simplify 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 here **
enc = encSt
 
End Function
Public Function dec(tIp As String, dD As Double, dN As Double) As String
'returns the characters from the long values
'e.g A = 12345678, B = 23456789 etc..
'**Taken out decryption algorithm to simplify program**
On Error Resume Next
Dim decSt As String
decSt = ""
'** put your decryption algorithm code here **
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
winzip iconDownload code

Note: Due to the size or complexity of this submission, the author has submitted it as a .zip file to shorten your download time. Afterdownloading it, you will need a program like Winzip to decompress it.Virus note:All files are scanned once-a-day by Planet Source Code for viruses, but new viruses come out every day, so no prevention program can catch 100% of them. For your own safety, please:
  1. Re-scan downloaded files using your personal virus checker before using it.
  2. NEVER, EVER run compiled files (.exe's, .ocx's, .dll's etc.)--only run source code.
  3. Scan the source code with Minnow's Project Scanner

If you don't have a virus scanner, you can get one at many places on the net including:McAfee.com


Other 2 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Advanced category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.