Cryptology with Liberty BASIC : 103

First Part Title

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