5 hours ago
I asked Claude to generate the RSA-2048 algorithm (encryption/decryption) and here it is in PBCC 6.0.
No Crypto API calls. The generation of the key takes quite some time. Be patient.
No Crypto API calls. The generation of the key takes quite some time. Be patient.
Code:
' ==============================================================================
' RSA2048.bas - RSA-2048 in pure PowerBasic (no Windows Crypto API)
'
' - Big numbers: arrays of QUAD, each element holds one 16-bit limb
' (little-endian: element 0 = least significant 16 bits).
' 16-bit limbs keep every intermediate product well inside a signed QUAD.
' - Modular exponentiation: Montgomery multiplication (no big division needed)
' - Key generation: random 1024-bit primes, trial division + Miller-Rabin
' - Private exponent: derived without big division (e is small, see below)
' - Padding: PKCS#1 v1.5 (type 2) for text messages, max 245 bytes
'
' Written as a PBCC console program. For PBWin, replace PRINT/WAITKEY$ with
' MSGBOX or file output.
'
' WARNING - educational code:
' * RND is NOT a cryptographically secure random source. For real keys use
' an OS entropy source.
' * Not constant-time (timing side channels), no CRT, no blinding.
' * PKCS#1 v1.5 padding is legacy; OAEP would need a hash function.
'==============================================================================
#Compile Exe
#Dim All
#Include "Win32Api.Inc" ' only for QueryPerformanceCounter (seeding)
%LIMBS_MAX = 136 ' 128 limbs = 2048 bits, plus guard limbs
%KEY_LIMBS = 128 ' 2048 bits
%HALF_LIMBS = 64 ' 1024 bits (p and q)
%E_PUBLIC = 65537
%MR_ROUNDS = 10 ' Miller-Rabin rounds (bases = first primes)
Global g_L As Long ' limbs in current modulus
Global g_Ninv As Quad ' -n^-1 mod 2^16
Global g_N() As Quad ' current modulus
Global g_R2() As Quad ' R^2 mod n, R = 2^(16*L)
Global g_T() As Quad ' scratch for MontMul
Global g_SP() As Long ' small primes
Global g_SPCount As Long
'------------------------------------------------------------------------------
' Basic big-number helpers
'------------------------------------------------------------------------------
Sub BnClear(a() As Quad)
Local i As Long
For i = 0 To %LIMBS_MAX - 1
a(i) = 0
Next
End Sub
Sub BnCopy(src() As Quad, dst() As Quad)
Local i As Long
For i = 0 To %LIMBS_MAX - 1
dst(i) = src(i)
Next
End Sub
' compare over n limbs: -1, 0, 1
Function BnCmp(a() As Quad, b() As Quad, ByVal n As Long) As Long
Local i As Long
For i = n - 1 To 0 Step -1
If a(i) > b(i) Then Function = 1 : Exit Function
If a(i) < b(i) Then Function = -1 : Exit Function
Next
Function = 0
End Function
' a = a - b over n limbs (a >= b assumed, or the borrow is dropped)
Sub BnSubInPlace(a() As Quad, b() As Quad, ByVal n As Long)
Local i As Long
Local d As Quad, borrow As Quad
borrow = 0
For i = 0 To n - 1
d = a(i) - b(i) - borrow
If d < 0 Then
d = d + 65536 : borrow = 1
Else
borrow = 0
End If
a(i) = d
Next
End Sub
' a = a >> 1 over n limbs
Sub BnShr1(a() As Quad, ByVal n As Long)
Local i As Long
Local t As Quad, carry As Quad
carry = 0
For i = n - 1 To 0 Step -1
t = a(i)
a(i) = (t + carry * 65536) \ 2
carry = t And 1
Next
End Sub
Function BnBitLength(a() As Quad, ByVal n As Long) As Long
Local i As Long, b As Long
Local v As Quad
For i = n - 1 To 0 Step -1
If a(i) <> 0 Then
v = a(i) : b = 0
Do While v > 0
Incr b
v = v \ 2
Loop
Function = i * 16 + b
Exit Function
End If
Next
Function = 0
End Function
Function BnGetBit(a() As Quad, ByVal bitNo As Long) As Long
Local k As Long
Local v As Quad
v = a(bitNo \ 16)
For k = 1 To (bitNo Mod 16)
v = v \ 2
Next
Function = (v And 1)
End Function
' remainder of a (n limbs) divided by small m (m < 2^31)
Function BnModSmall(a() As Quad, ByVal n As Long, ByVal m As Long) As Long
Local i As Long
Local r As Quad
r = 0
For i = n - 1 To 0 Step -1
r = (r * 65536 + a(i)) Mod m
Next
Function = r
End Function
' a = a \ m over n limbs, returns remainder
Function BnDivSmall(a() As Quad, ByVal n As Long, ByVal m As Long) As Long
Local i As Long
Local r As Quad, Qcur As Quad
r = 0
For i = n - 1 To 0 Step -1
Qcur = r * 65536 + a(i)
a(i) = Qcur \ m
r = Qcur Mod m
Next
Function = r
End Function
' a = a * m + addv over n limbs (m <= 65536, caller guarantees no overflow)
Sub BnMulSmallAdd(a() As Quad, ByVal n As Long, ByVal m As Long, ByVal addv As Long)
Local i As Long
Local s As Quad, c As Quad
c = addv
For i = 0 To n - 1
s = a(i) * m + c
a(i) = s And 65535
c = s \ 65536
Next
End Sub
' r = a * b (schoolbook). r must be a different array than a and b.
Sub BnMul(a() As Quad, ByVal na As Long, b() As Quad, ByVal nb As Long, r() As Quad)
Local i As Long, j As Long
Local s As Quad, c As Quad
Call BnClear(r())
For i = 0 To na - 1
c = 0
For j = 0 To nb - 1
s = r(i + j) + a(i) * b(j) + c
r(i + j) = s And 65535
c = s \ 65536
Next
r(i + nb) = c
Next
End Sub
' inverse of a modulo m (small numbers, extended Euclid), 0 if none
Function ModInvSmall(ByVal a As Quad, ByVal m As Quad) As Quad
Local t As Quad, newt As Quad, r As Quad, newr As Quad
Local q As Quad, tmp As Quad
t = 0 : newt = 1 : r = m : newr = a
Do While newr <> 0
q = r \ newr
tmp = t - q * newt : t = newt : newt = tmp
tmp = r - q * newr : r = newr : newr = tmp
Loop
If r > 1 Then Function = 0 : Exit Function
If t < 0 Then t = t + m
Function = t
End Function
'------------------------------------------------------------------------------
' Montgomery arithmetic
'------------------------------------------------------------------------------
' Select the (odd) modulus n of L limbs and precompute constants.
Sub SetModulus(n() As Quad, ByVal L As Long)
Local i As Long, k As Long
Local Qinv As Quad, n0 As Quad, s As Quad, carry As Quad
Dim x(0 To %LIMBS_MAX - 1) As Local Quad
g_L = L
For i = 0 To %LIMBS_MAX - 1
g_N(i) = 0 : g_R2(i) = 0 : x(i) = 0
Next
For i = 0 To L - 1
g_N(i) = n(i)
Next
' n0^-1 mod 2^16 by Newton iteration, then negate
n0 = n(0) : Qinv = n0
For i = 1 To 4
Qinv = (Qinv * (2 - n0 * Qinv)) And 65535
Next
g_Ninv = (65536 - Qinv) And 65535
' R^2 mod n = 2^(32*L) mod n : start at 1, double 32*L times with reduction
x(0) = 1
For k = 1 To 32 * L
carry = 0
For i = 0 To L - 1
s = x(i) * 2 + carry
x(i) = s And 65535
carry = s \ 65536
Next
If carry <> 0 Then
Call BnSubInPlace(x(), g_N(), L)
ElseIf BnCmp(x(), g_N(), L) >= 0 Then
Call BnSubInPlace(x(), g_N(), L)
End If
Next
For i = 0 To L - 1
g_R2(i) = x(i)
Next
End Sub
' r = a * b * R^-1 mod n (CIOS method). r may be the same array as a or b.
Sub MontMul(a() As Quad, b() As Quad, r() As Quad)
Local i As Long, j As Long, L As Long
Local s As Quad, c As Quad, m As Quad, bi As Quad
L = g_L
For i = 0 To L + 1
g_T(i) = 0
Next
For i = 0 To L - 1
bi = b(i) : c = 0
For j = 0 To L - 1
s = g_T(j) + a(j) * bi + c
g_T(j) = s And 65535
c = s \ 65536
Next
s = g_T(L) + c
g_T(L) = s And 65535
g_T(L + 1) = s \ 65536
m = (g_T(0) * g_Ninv) And 65535
s = g_T(0) + m * g_N(0)
c = s \ 65536
For j = 1 To L - 1
s = g_T(j) + m * g_N(j) + c
g_T(j - 1) = s And 65535
c = s \ 65536
Next
s = g_T(L) + c
g_T(L - 1) = s And 65535
g_T(L) = g_T(L + 1) + (s \ 65536)
g_T(L + 1) = 0
Next
For i = 0 To L - 1
r(i) = g_T(i)
Next
For i = L To %LIMBS_MAX - 1
r(i) = 0
Next
If g_T(L) <> 0 Then
Call BnSubInPlace(r(), g_N(), L)
ElseIf BnCmp(r(), g_N(), L) >= 0 Then
Call BnSubInPlace(r(), g_N(), L)
End If
End Sub
' res = a * b mod n (plain, non-Montgomery in/out)
Sub ModMulPlain(a() As Quad, b() As Quad, r() As Quad)
Dim tmp(0 To %LIMBS_MAX - 1) As Local Quad
Call MontMul(a(), b(), tmp())
Call MontMul(tmp(), g_R2(), r())
End Sub
' res = base ^ ex mod n (base < n; modulus must be set with SetModulus)
Sub ModPow(Qbase() As Quad, ex() As Quad, ByVal exLimbs As Long, Res() As Quad)
Local bitNo As Long, nbits As Long
Dim bm(0 To %LIMBS_MAX - 1) As Local Quad
Dim acc(0 To %LIMBS_MAX - 1) As Local Quad
Dim one(0 To %LIMBS_MAX - 1) As Local Quad
Call BnClear(one())
one(0) = 1
Call MontMul(Qbase(), g_R2(), bm()) ' base in Montgomery form
Call MontMul(one(), g_R2(), acc()) ' 1 in Montgomery form
nbits = BnBitLength(ex(), exLimbs)
For bitNo = nbits - 1 To 0 Step -1
Call MontMul(acc(), acc(), acc())
If BnGetBit(ex(), bitNo) = 1 Then
Call MontMul(acc(), bm(), acc())
End If
Next
Call MontMul(acc(), one(), Res()) ' back to normal form
End Sub
'------------------------------------------------------------------------------
' Random numbers, small primes, primality test
'------------------------------------------------------------------------------
Sub InitSmallPrimes
Local i As Long, j As Long
Dim comp(0 To 2000) As Local Byte
g_SPCount = 0
For i = 2 To 2000
If comp(i) = 0 Then
g_SP(g_SPCount) = i
Incr g_SPCount
For j = i * i To 2000 Step i
comp(j) = 1
Next
End If
Next
End Sub
Sub SeedRandom
Local q As Quad, seed As Long, i As Long, dummy As Long
' Mixes several high-resolution timer samples. This is NOT strong entropy.
seed = 0
For i = 1 To 8
dummy = QueryPerformanceCounter(q)
seed = seed Xor CLng(q And &H7FFFFFFF)
seed = (seed * 31 + i) And &H7FFFFFFF
Sleep 1
Next
Randomize seed
End Sub
Function RndLimb() As Quad
Function = Int(Rnd * 65536)
End Function
' Miller-Rabin using the first %MR_ROUNDS small primes as bases
Function IsProbablePrime(n() As Quad, ByVal L As Long) As Long
Local i As Long, s As Long, r As Long, rounds As Long, passed As Long
Dim d(0 To %LIMBS_MAX - 1) As Local Quad
Dim nm1(0 To %LIMBS_MAX - 1) As Local Quad
Dim x(0 To %LIMBS_MAX - 1) As Local Quad
Dim a(0 To %LIMBS_MAX - 1) As Local Quad
Dim one(0 To %LIMBS_MAX - 1) As Local Quad
Call SetModulus(n(), L)
For i = 0 To %LIMBS_MAX - 1
d(i) = n(i) : nm1(i) = n(i) : one(i) = 0
Next
d(0) = d(0) - 1 ' n is odd, so no borrow
nm1(0) = nm1(0) - 1
one(0) = 1
s = 0
Do While (d(0) And 1) = 0
Call BnShr1(d(), L)
Incr s
Loop
For rounds = 0 To %MR_ROUNDS - 1
Call BnClear(a())
a(0) = g_SP(rounds)
Call ModPow(a(), d(), L, x())
If BnCmp(x(), one(), L) <> 0 And BnCmp(x(), nm1(), L) <> 0 Then
passed = 0
For r = 1 To s - 1
Call ModMulPlain(x(), x(), x())
If BnCmp(x(), nm1(), L) = 0 Then
passed = 1
Exit For
End If
Next
If passed = 0 Then Function = 0 : Exit Function
End If
Next
Function = 1
End Function
' random prime of L limbs: top two bits set, odd, (p-1) not divisible by e
Sub GenPrime(p() As Quad, ByVal L As Long)
Local i As Long, k As Long, ok As Long
Do
Call BnClear(p())
For i = 0 To L - 1
p(i) = RndLimb()
Next
p(0) = p(0) Or 1
p(L - 1) = p(L - 1) Or 49152 ' &HC000
ok = 1
If BnModSmall(p(), L, %E_PUBLIC) = 1 Then ok = 0 ' p-1 divisible by e
If ok = 1 Then
For k = 0 To g_SPCount - 1
If BnModSmall(p(), L, g_SP(k)) = 0 Then ok = 0 : Exit For
Next
End If
If ok = 1 Then
If IsProbablePrime(p(), L) = 1 Then Exit Sub
End If
Loop
End Sub
'------------------------------------------------------------------------------
' Key generation
' n = p*q, e = 65537, d = e^-1 mod (p-1)(q-1)
' d without big division: choose k in [1,e-1] with (1 + k*phi) divisible by e
' (k = -phi^-1 mod e, computed with small integers), then d = (1 + k*phi)/e.
'------------------------------------------------------------------------------
Sub RsaGenerateKey(n() As Quad, d() As Quad)
Local r As Long, k As Long, i As Long
Dim p(0 To %LIMBS_MAX - 1) As Local Quad
Dim q(0 To %LIMBS_MAX - 1) As Local Quad
Dim p1(0 To %LIMBS_MAX - 1) As Local Quad
Dim q1(0 To %LIMBS_MAX - 1) As Local Quad
Dim phi(0 To %LIMBS_MAX - 1) As Local Quad
Do
Call GenPrime(p(), %HALF_LIMBS)
Do
Call GenPrime(q(), %HALF_LIMBS)
Loop While BnCmp(p(), q(), %HALF_LIMBS) = 0
Call BnMul(p(), %HALF_LIMBS, q(), %HALF_LIMBS, n())
Call BnCopy(p(), p1()) : p1(0) = p1(0) - 1 ' primes are odd
Call BnCopy(q(), q1()) : q1(0) = q1(0) - 1
Call BnMul(p1(), %HALF_LIMBS, q1(), %HALF_LIMBS, phi())
r = BnModSmall(phi(), %KEY_LIMBS, %E_PUBLIC)
If r <> 0 Then Exit Do ' gcd(e, phi) = 1
Loop
k = (%E_PUBLIC - ModInvSmall(r, %E_PUBLIC)) Mod %E_PUBLIC
Call BnMulSmallAdd(phi(), %KEY_LIMBS + 2, k, 1) ' phi = 1 + k*phi
Call BnDivSmall(phi(), %KEY_LIMBS + 2, %E_PUBLIC) ' exact division
Call BnClear(d())
For i = 0 To %KEY_LIMBS - 1
d(i) = phi(i)
Next
End Sub
'------------------------------------------------------------------------------
' Conversions
'------------------------------------------------------------------------------
' big-endian byte string (even length) -> big number
Sub BytesToBn(s As String, a() As Quad)
Local i As Long, ln As Long
ln = Len(s)
Call BnClear(a())
For i = 0 To (ln \ 2) - 1
a(i) = Asc(s, ln - 2 * i) + 256 * Asc(s, ln - 2 * i - 1)
Next
End Sub
' big number -> big-endian byte string of nbytes (even)
Function BnToBytes(a() As Quad, ByVal nbytes As Long) As String
Local i As Long
Local s As String
s = String$(nbytes, 0)
For i = 0 To (nbytes \ 2) - 1
Asc(s, nbytes - 2 * i) = CLng(a(i) And 255)
Asc(s, nbytes - 2 * i - 1) = CLng((a(i) \ 256) And 255)
Next
Function = s
End Function
Function BnToHex(a() As Quad, ByVal n As Long) As String
Local i As Long
Local s As String
For i = n - 1 To 0 Step -1
s = s + Hex$(CLng(a(i)), 4)
Next
Function = s
End Function
Function BytesToHex(s As String) As String
Local i As Long
Local h As String
For i = 1 To Len(s)
h = h + Hex$(Asc(s, i), 2)
Next
Function = h
End Function
'------------------------------------------------------------------------------
' Encrypt / decrypt with PKCS#1 v1.5 (type 2) padding
' EM = 00 02 PS(>=8 random nonzero bytes) 00 M (256 bytes)
'------------------------------------------------------------------------------
Function RsaEncrypt(msg As String, n() As Quad) As String
Local mlen As Long, i As Long
Local em As String
Dim m(0 To %LIMBS_MAX - 1) As Local Quad
Dim c(0 To %LIMBS_MAX - 1) As Local Quad
Dim ex(0 To %LIMBS_MAX - 1) As Local Quad
mlen = Len(msg)
If mlen > 245 Then Function = "" : Exit Function
em = String$(256, 0)
Asc(em, 2) = 2
For i = 3 To 256 - mlen - 1
Asc(em, i) = 1 + Int(Rnd * 255)
Next
If mlen > 0 Then Mid$(em, 257 - mlen, mlen) = msg
Call BytesToBn(em, m())
Call SetModulus(n(), %KEY_LIMBS)
Call BnClear(ex())
ex(0) = 1 : ex(1) = 1 ' 65537 = &H10001
Call ModPow(m(), ex(), 2, c())
Function = BnToBytes(c(), 256)
End Function
Function RsaDecrypt(cipher As String, n() As Quad, d() As Quad) As String
Local i As Long
Local em As String
Dim c(0 To %LIMBS_MAX - 1) As Local Quad
Dim m(0 To %LIMBS_MAX - 1) As Local Quad
If Len(cipher) <> 256 Then Function = "" : Exit Function
Call BytesToBn(cipher, c())
If BnCmp(c(), n(), %KEY_LIMBS) >= 0 Then Function = "" : Exit Function
Call SetModulus(n(), %KEY_LIMBS)
Call ModPow(c(), d(), %KEY_LIMBS, m())
em = BnToBytes(m(), 256)
If Asc(em, 1) <> 0 Or Asc(em, 2) <> 2 Then Function = "" : Exit Function
For i = 3 To 256
If Asc(em, i) = 0 Then Exit For
Next
If i < 11 Or i > 256 Then Function = "" : Exit Function ' bad padding
Function = Mid$(em, i + 1)
End Function
'------------------------------------------------------------------------------
' Demo
'------------------------------------------------------------------------------
Function PBMain() As Long
Local msg As String, cipher As String, plain As String
Local t0 As Single
Dim n(0 To %LIMBS_MAX - 1) As Quad
Dim d(0 To %LIMBS_MAX - 1) As Quad
ReDim g_N(0 To %LIMBS_MAX - 1)
ReDim g_R2(0 To %LIMBS_MAX - 1)
ReDim g_T(0 To %LIMBS_MAX + 1)
ReDim g_SP(0 To 399)
Call InitSmallPrimes
Call SeedRandom
Print "Generating RSA-2048 key (two 1024-bit primes), please wait..."
t0 = Timer
Call RsaGenerateKey(n(), d())
Print "Done in "; Using$("##.#", Timer - t0); " s"
Print
Print "Modulus n (hex):"
Print BnToHex(n(), %KEY_LIMBS)
Print
Print "Public exponent e = "; %E_PUBLIC
Print
msg = "Hello from pure PowerBasic RSA-2048!"
Print "Message : "; msg
cipher = RsaEncrypt(msg, n())
Print "Cipher : "; BytesToHex(cipher)
Print
plain = RsaDecrypt(cipher, n(), d())
Print "Decrypted: "; plain
If plain = msg Then
Print "Round trip OK."
Else
Print "Round trip FAILED."
End If
Print
Print "Press any key..."
WaitKey$
End Function