 # 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: 4642

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``` Download 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 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.