RodBird
Oct 8, 2017
Cryptology with Liberty BASIC : 103
authorCryptology with Liberty BASIC : 103 | First Part Title | Second Part Title | Third Part Title
First Part Title
Text here.[begin] print "Liberty Basic RSA Demonstration" print "Loading Small Primes" for i=1 to 1000 read x SmallPrimes(i)=x next NoOfSmallPrimes=1000 print NoOfSmallPrimes;" Primes Loaded" print"Generating Random Primes"
for i=1 to 2 t1=time$("ms")
[TryAnother] print print "Prime No ";i if i=1 then x=Random(30) else x=Random(30) iterations=0
[Loop] iterations=iterations+1 if MillerRabin(x,7)=1 then 'print "Composite" x=x+2 goto [Loop] else t2=time$("ms") print x;" Probably Prime. Generated in ";t2-t1;" milliseconds" end if if p then q=x else p=x next i print print "p=";dechex$(p)
[Retry] restore print "q=";dechex$(q)
'Common modulus N=(p)(q) n=p*q print "Key Length ";len(dechex$(n))*4;" bits " print
'Euler Totient Number M=(p-1)(q-1) m=(p-1)*(q-1)
'Choose a suitable prime E relatively prime to M for i=1 to 12 read e if (GCD(e,m)=1) then goto [Start] next i
[Start] print "Common Modulus, n=";dechex$(n) print "Euler-Totient No, m=";dechex$(m) print "Public Exponent, e=";dechex$(e) d=ExtBinEuclid( e, m ) print "Secret Exponent, d=";dechex$(d)
DIM TEST(10) DIM ENCR(10) DIM DECR(10) TEST(1)=TEXT2DEC("LIBERTY BASIC IS THE BEST") TEST(2)=TEXT2DEC("WHICH BASIC CAN DO THIS ") TEST(3)=TEXT2DEC("WITHOUT CALLING EXT DLL ?") TEST(4)=TEXT2DEC("LB CAN DO BIG INTEGERS ! ") TEST(5)=TEXT2DEC("UNDOCUMENTED LB FEATURE. ") print print "RSA ENCRYPTION DEMO" for i=1 to 5 t1=time$("ms") ENCR(i)=FastExp(TEST(i), e, n) t2=time$("ms") print TEST(i); print " ";ENCR(i); print " ";t2-t1;" ms" print DEC2TEXT$( TEST(i) );" --> ";DEC2TEXT$( ENCR(i) ) print next i print print "" print print "RSA DECRYPTION DEMO" for i=1 to 5 t1=time$("ms") DECR(i)=FastExp(ENCR(i), d, n) t2=time$("ms") print ENCR(i); print " ";DECR(i); print " ";t2-t1;" ms" print DEC2TEXT$( ENCR(i) );" --> ";DEC2TEXT$( DECR(i) ) print next i print " " print print "RSA Demo Finished."
[stop]END
Function GCD( m,n ) ' Find greatest common divisor with Extend Euclidian Algorithm ' Knuth Vol 1 P.13 Algorithm E ap =1 :b =1 :a =0 :bp =0: c =m :d =n [StepE2] q = int(c/d) :r = c-q*d if r<>0 then c=d :d=r :t=ap :ap=a :a=t-q*a :t=bp :bp=b :b=t-q*b 'print ap;" ";b;" ";a;" ";bp;" ";c;" ";d;" ";t;" ";q goto [StepE2] end if GCD=a*m+b*n 'print ap;" ";b;" ";a;" ";bp;" ";c;" ";d;" ";t;" ";q
End Function 'Extended Euclidian GCD
Function ExtBinEuclid( u, v ) k=0 :t1=0 :t2=0 :t3=0 if u<v then temp=u u=v v=temp end if while (IsEven( u ) and IsEven( v )) k = k+1 u = int(u/2) v = int(v/2) wend u1 = 1: u2 = 0: u3 =u: t1 =v: t2 =u-1: t3 =v
[Loop1] 'two labels with no code!
[Loop2] ' print "*" if (IsEven(u3)) then if IsOdd(u1) or IsOdd(u2) then u1=u1+v u2=u2+u end if u1=int(u1/2) u2=int(u2/2) u3=int(u3/2) end if if IsEven(t3) or (u3<t3) then temp=u1: u1=t1: t1=temp temp=u2: u2=t2: t2=temp temp=u3: u3=t3: t3=temp end if if IsEven(u3) then goto [Loop2] end if
while u1<t1 OR u2<t2 u1=u1+v: u2=u2+u wend u1=u1-t1: u2=u2-t2: u3=u3-t3 if (t3>0) then goto [Loop1] end if
while u1>=v AND u2>=u u1=ul-v: u2=u2-u wend ExtBinEuclid=u-u2End Function
function IsEven( x ) if ( x MOD 2 )=0 then IsEven=1 else IsEven=0 end ifend function
function IsOdd( x ) if ( x MOD 2 )=0 then IsOdd=0 else IsOdd=1 end ifend function
Function FastExp(x, y, N) if (y=1) then 'MOD(x,N) FastExp=x-int(x/N)*N goto [ExitFunction] end if if ( y and 1) = 0 then dum1=y/2 dum2=y-int(y/2)*2 'MOD(y,2) temp=FastExp(x,dum1,N) z=temp*temp FastExp=z-int(z/N)*N 'MOD(temp*temp,N) goto [ExitFunction] else dum1=y-1 dum1=dum1/2 temp=FastExp(x,dum1,N) dum2=temp*temp temp=dum2-int(dum2/N)*N 'MOD(dum2,N) z=temp*x FastExp=z-int(z/N)*N 'MOD(temp*x,N) goto [ExitFunction] end if
[ExitFunction]end function
Function PowMod( a, n, m) r = 1 while (n > 0) if (n AND 1) then '/* test lowest bit */ r = MulMod(r, a, m) '/* multiply (mod m) */ end if a = MulMod(a, a, m) '/* square */ n = int(n/2) '/* divided by 2 */ wend PowMod=rEnd Function
Function MulMod( a, b, m) if (m = 0) then MulMod=a * b ' /* (mod 0) */ Else r = 0 while (a > 0) if (a AND 1) then ' /* test lowest bit */ r= r+b if (r > m) then r = (r MOD m) ' /* add (mod m) */ end if end if a = int(a/2) ' /* divided by 2 */ b = b*2 if (b > m) then b = (b MOD m) ' /* times 2 (mod m) */ end if wend MulMod=r End IfEnd Function
Function rand( x ) x=x*5 x=x+1 rand=xEnd Function
Function MillerRabin(n,b) 'print "Miller Rabin" 't1=time$("ms") if IsEven(n) then MillerRabin=1 goto [ExtFn] end if i=0
[Loop] i=i+1 if i>1000 then goto [Continue] if ( n MOD SmallPrimes(i) )=0 then MillerRabin=1 goto [ExtFn] end if goto [Loop]
[Continue] if GCD(n,b)>1 then MillerRabin=1 goto [ExtFn] end if q=n-1 t=0 while (int(q) AND 1 )=0 t=t+1 q=int(q/2) wend r=FastExp(b, q, n) if ( r <> 1 ) then e=0 while ( e < (t-1) ) if ( r <> (n-1) ) then r=FastExp(r, r, n) else Exit While end if e=e+1 wend [ExitLoop] end if if ( (r=1) OR (r=(n-1)) ) then MillerRabin=0 else MillerRabin=1 end if
[ExtFn]End Function
Function Random( Digits )' x=INT(RND(1)*TIME$("ms")*9912812828239112219) * INT(RND(1)*9912166437771297131373) *' INT(RND(1)*71777126181142123) * INT(RND(1)*7119119672435637981) *' INT(RND(1)*991216643912127789) * INT(RND(1)*79126181142123) *' INT(RND(1)*711911128376332417) * INT(RND(1)*991216643123129) *' INT(RND(1)*79126181142123) * INT(RND(1)*6661912727312317)' Random=INT(VAL(RIGHT$(STR$(x,1)))
x=INT(RND(1)*TIME$("ms")*9912812828239112219) * INT(RND(1)*9912166437771297131373) *_ INT(RND(1)*71777126181142123) * INT(RND(1)*7119119672435637981) *_ INT(RND(1)*991216643912127789) * INT(RND(1)*79126181142123) *_ INT(RND(1)*711911128376332417) x=x*x+x+41 y$=mid$(str$(x),INT(rnd(1)*30+1),Digits ) ldg=val(right$(y$,1)) z=0 if ldg=0 then z=1 if ldg=2 then z=1 if ldg=4 then z=1 if ldg=6 then z=1 if ldg=8 then z=1 Random=val(y$)+zEnd Function
FUNCTION TEXT2DEC( x$ ) a$=UPPER$(x$) y$="" FOR i=1 TO LEN(a$) y$=y$+STR$(ASC(MID$(a$,i,1))) NEXT TEXT2DEC=VAL(y$)END FUNCTION
FUNCTION DEC2TEXT$( n ) a$=STR$(n) y$="" FOR i=1 TO LEN(a$)-1 STEP 2 m=VAL(MID$(a$,i,2)) if m>30 and m<99 then y$=y$+CHR$(m) else y$=y$+"." NEXT DEC2TEXT$=y$END FUNCTION
data 2, 3, 5, 7, 11, 13, 17, 19, 23, 29data 31, 37, 41, 43, 47, 53, 59, 61, 67, 71data 73, 79, 83, 89, 97, 101, 103, 107, 109, 113data 127, 131, 137, 139, 149, 151, 157, 163, 167, 173data 179, 181, 191, 193, 197, 199, 211, 223, 227, 229data 233, 239, 241, 251, 257, 263, 269, 271, 277, 281data 283, 293, 307, 311, 313, 317, 331, 337, 347, 349data 353, 359, 367, 373, 379, 383, 389, 397, 401, 409data 419, 421, 431, 433, 439, 443, 449, 457, 461, 463data 467, 479, 487, 491, 499, 503, 509, 521, 523, 541data 547, 557, 563, 569, 571, 577, 587, 593, 599, 601data 607, 613, 617, 619, 631, 641, 643, 647, 653, 659data 661, 673, 677, 683, 691, 701, 709, 719, 727, 733data 739, 743, 751, 757, 761, 769, 773, 787, 797, 809data 811, 821, 823, 827, 829, 839, 853, 857, 859, 863data 877, 881, 883, 887, 907, 911, 919, 929, 937, 941data 947, 953, 967, 971, 977, 983, 991, 997, 1009, 1013data 1019, 1021, 1031, 1033, 1039, 1049, 1051, 1061, 1063, 1069data 1087, 1091, 1093, 1097, 1103, 1109, 1117, 1123, 1129, 1151data 1153, 1163, 1171, 1181, 1187, 1193, 1201, 1213, 1217, 1223data 1229, 1231, 1237, 1249, 1259, 1277, 1279, 1283, 1289, 1291data 1297, 1301, 1303, 1307, 1319, 1321, 1327, 1361, 1367, 1373data 1381, 1399, 1409, 1423, 1427, 1429, 1433, 1439, 1447, 1451data 1453, 1459, 1471, 1481, 1483, 1487, 1489, 1493, 1499, 1511data 1523, 1531, 1543, 1549, 1553, 1559, 1567, 1571, 1579, 1583data 1597, 1601, 1607, 1609, 1613, 1619, 1621, 1627, 1637, 1657data 1663, 1667, 1669, 1693, 1697, 1699, 1709, 1721, 1723, 1733data 1741, 1747, 1753, 1759, 1777, 1783, 1787, 1789, 1801, 1811data 1823, 1831, 1847, 1861, 1867, 1871, 1873, 1877, 1879, 1889data 1901, 1907, 1913, 1931, 1933, 1949, 1951, 1973, 1979, 1987data 1993, 1997, 1999, 2003, 2011, 2017, 2027, 2029, 2039, 2053data 2063, 2069, 2081, 2083, 2087, 2089, 2099, 2111, 2113, 2129data 2131, 2137, 2141, 2143, 2153, 2161, 2179, 2203, 2207, 2213data 2221, 2237, 2239, 2243, 2251, 2267, 2269, 2273, 2281, 2287data 2293, 2297, 2309, 2311, 2333, 2339, 2341, 2347, 2351, 2357data 2371, 2377, 2381, 2383, 2389, 2393, 2399, 2411, 2417, 2423data 2437, 2441, 2447, 2459, 2467, 2473, 2477, 2503, 2521, 2531data 2539, 2543, 2549, 2551, 2557, 2579, 2591, 2593, 2609, 2617data 2621, 2633, 2647, 2657, 2659, 2663, 2671, 2677, 2683, 2687data 2689, 2693, 2699, 2707, 2711, 2713, 2719, 2729, 2731, 2741data 2749, 2753, 2767, 2777, 2789, 2791, 2797, 2801, 2803, 2819data 2833, 2837, 2843, 2851, 2857, 2861, 2879, 2887, 2897, 2903data 2909, 2917, 2927, 2939, 2953, 2957, 2963, 2969, 2971, 2999data 3001, 3011, 3019, 3023, 3037, 3041, 3049, 3061, 3067, 3079data 3083, 3089, 3109, 3119, 3121, 3137, 3163, 3167, 3169, 3181data 3187, 3191, 3203, 3209, 3217, 3221, 3229, 3251, 3253, 3257data 3259, 3271, 3299, 3301, 3307, 3313, 3319, 3323, 3329, 3331data 3343, 3347, 3359, 3361, 3371, 3373, 3389, 3391, 3407, 3413data 3433, 3449, 3457, 3461, 3463, 3467, 3469, 3491, 3499, 3511data 3517, 3527, 3529, 3533, 3539, 3541, 3547, 3557, 3559, 3571data 3581, 3583, 3593, 3607, 3613, 3617, 3623, 3631, 3637, 3643data 3659, 3671, 3673, 3677, 3691, 3697, 3701, 3709, 3719, 3727data 3733, 3739, 3761, 3767, 3769, 3779, 3793, 3797, 3803, 3821data 3823, 3833, 3847, 3851, 3853, 3863, 3877, 3881, 3889, 3907data 3911, 3917, 3919, 3923, 3929, 3931, 3943, 3947, 3967, 3989data 4001, 4003, 4007, 4013, 4019, 4021, 4027, 4049, 4051, 4057data 4073, 4079, 4091, 4093, 4099, 4111, 4127, 4129, 4133, 4139data 4153, 4157, 4159, 4177, 4201, 4211, 4217, 4219, 4229, 4231data 4241, 4243, 4253, 4259, 4261, 4271, 4273, 4283, 4289, 4297data 4327, 4337, 4339, 4349, 4357, 4363, 4373, 4391, 4397, 4409data 4421, 4423, 4441, 4447, 4451, 4457, 4463, 4481, 4483, 4493data 4507, 4513, 4517, 4519, 4523, 4547, 4549, 4561, 4567, 4583data 4591, 4597, 4603, 4621, 4637, 4639, 4643, 4649, 4651, 4657data 4663, 4673, 4679, 4691, 4703, 4721, 4723, 4729, 4733, 4751data 4759, 4783, 4787, 4789, 4793, 4799, 4801, 4813, 4817, 4831data 4861, 4871, 4877, 4889, 4903, 4909, 4919, 4931, 4933, 4937data 4943, 4951, 4957, 4967, 4969, 4973, 4987, 4993, 4999, 5003data 5009, 5011, 5021, 5023, 5039, 5051, 5059, 5077, 5081, 5087data 5099, 5101, 5107, 5113, 5119, 5147, 5153, 5167, 5171, 5179data 5189, 5197, 5209, 5227, 5231, 5233, 5237, 5261, 5273, 5279data 5281, 5297, 5303, 5309, 5323, 5333, 5347, 5351, 5381, 5387data 5393, 5399, 5407, 5413, 5417, 5419, 5431, 5437, 5441, 5443data 5449, 5471, 5477, 5479, 5483, 5501, 5503, 5507, 5519, 5521data 5527, 5531, 5557, 5563, 5569, 5573, 5581, 5591, 5623, 5639data 5641, 5647, 5651, 5653, 5657, 5659, 5669, 5683, 5689, 5693data 5701, 5711, 5717, 5737, 5741, 5743, 5749, 5779, 5783, 5791data 5801, 5807, 5813, 5821, 5827, 5839, 5843, 5849, 5851, 5857data 5861, 5867, 5869, 5879, 5881, 5897, 5903, 5923, 5927, 5939data 5953, 5981, 5987, 6007, 6011, 6029, 6037, 6043, 6047, 6053data 6067, 6073, 6079, 6089, 6091, 6101, 6113, 6121, 6131, 6133data 6143, 6151, 6163, 6173, 6197, 6199, 6203, 6211, 6217, 6221data 6229, 6247, 6257, 6263, 6269, 6271, 6277, 6287, 6299, 6301data 6311, 6317, 6323, 6329, 6337, 6343, 6353, 6359, 6361, 6367data 6373, 6379, 6389, 6397, 6421, 6427, 6449, 6451, 6469, 6473data 6481, 6491, 6521, 6529, 6547, 6551, 6553, 6563, 6569, 6571data 6577, 6581, 6599, 6607, 6619, 6637, 6653, 6659, 6661, 6673data 6679, 6689, 6691, 6701, 6703, 6709, 6719, 6733, 6737, 6761data 6763, 6779, 6781, 6791, 6793, 6803, 6823, 6827, 6829, 6833data 6841, 6857, 6863, 6869, 6871, 6883, 6899, 6907, 6911, 6917data 6947, 6949, 6959, 6961, 6967, 6971, 6977, 6983, 6991, 6997data 7001, 7013, 7019, 7027, 7039, 7043, 7057, 7069, 7079, 7103data 7109, 7121, 7127, 7129, 7151, 7159, 7177, 7187, 7193, 7207data 7211, 7213, 7219, 7229, 7237, 7243, 7247, 7253, 7283, 7297data 7307, 7309, 7321, 7331, 7333, 7349, 7351, 7369, 7393, 7411data 7417, 7433, 7451, 7457, 7459, 7477, 7481, 7487, 7489, 7499data 7507, 7517, 7523, 7529, 7537, 7541, 7547, 7549, 7559, 7561data 7573, 7577, 7583, 7589, 7591, 7603, 7607, 7621, 7639, 7643data 7649, 7669, 7673, 7681, 7687, 7691, 7699, 7703, 7717, 7723data 7727, 7741, 7753, 7757, 7759, 7789, 7793, 7817, 7823, 7829data 7841, 7853, 7867, 7873, 7877, 7879, 7883, 7901, 7907, 7919
Second Part Title
Text here.'code here
Third Part Title
Text here.'code here
Cryptology with Liberty BASIC : 103 | First Part Title | Second Part Title | Third Part Title