开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 加密解密 > 查看源码
GInt.pas
资源名称：rsa.zip　[点击查看]
上传用户：master
上传日期：2007-01-06
资源大小：17k
文件大小：85k
源码类别：

加密解密

开发平台：

Pascal

GInt.pas：源码内容
  1. {License, info, etc
  2.  ------------------
  4. This implementation is made by Walied Othman, to contact me
  5. mail to Walied.Othman@Student.KULeuven.ac.be or
  6. Triade@ace.Ulyssis.Student.KULeuven.ac.be, or ICQ me on 20388046.
  7. If you 're going to use these implementations, at least mention my
  8. name or something and notify me so I may even put a link on my page.
  9. This implementation is freeware and according to the coderpunks'
  10. manifesto it should remain so, so don 't use these implementations
  11. in commercial applications.  Encryption, as a tool to ensure privacy
  12. should be free and accessible for anyone.
  13. If any algorithm is patented in your country, you should acquire a
  14. license before using this software.  Modified versions of this
  15. software must remain in the public domain and must contain an
  16. acknowledgement of the original author (=me).
  17. This implementaion is available at
  18. http://ace.ulyssis.student.kuleuven.ac.be/~triade/GInt/index.htm
  21. copyright 1999, Walied Othman
  22. This header may not be removed.
  24. Updates:
  25. --------
  26.  9/1/99: Division algorithm speeded up, 3 times faster now
  27. 22/1/99: Procedure Added to compute the Legendre symbol
  28. 26/2/99: The Procedure GIntToBinStr optimized
  29. 28/2/99: signtype changed
  30. 19/3/99: TrialDiv range expanded
  31. 23/3/99: BinStrToGInt optimized, 4 times faster now
  32.          GIntMulByInt and GIntMulByIntBis procedures added
  33. }
  35. Unit GInt;
  37. Interface
  39. Uses Windows, SysUtils, Controls;
  41. Type
  42.    TCompare = (Lt, St, Eq, Er);
  43.    Tsign = (negative, positive);
  44.    TGInt = ^cont;
  45.    cont = Record
  46.       sign : Tsign;
  47.       value : longint;
  48.       next, prev : TGInt;
  49.    End;
  51. Procedure zeronetochar8(Var g : char; x : String);
  52. Procedure zeronetochar6(Var g : integer; x : String);
  53. Procedure initialize8(Var trans : Array Of String);
  54. Procedure initialize6(Var trans : Array Of String);
  55. Procedure Convert8to6bit(str8 : String; Var str6 : String);
  56. Procedure Convert6to8bit(str6 : String; Var str8 : String);
  57. Procedure Convert8to1bit(str8 : String; Var str1 : String);
  58. Procedure Convert6to1bit(str6 : String; Var str1 : String);
  59. Procedure Convert1to8bit(str1 : String; Var str8 : String);
  60. Procedure Convert1to6bit(str1 : String; Var str6 : String);
  61. Procedure decstrtogint(GIntstr : String; Var GInt : TGInt);
  62. Procedure ginttodecstr(Var GIntstr : String; GInt : TGInt);
  63. Procedure InttoGInt(Int : integer; Var GInt : TGInt);
  64. Procedure gintdestroy(Var GInt : TGInt);
  65. Procedure GIntcopy(GInt1 : TGInt; Var GInt2 : TGInt);
  66. Procedure GIntdivbyint(GInt : TGInt; Var res : TGInt; by : longint; Var m : longint);
  67. Procedure GIntmodbyint(GInt : TGInt; by : longint; Var m : longint);
  68. Function GIntCompareAbs(GInt1, GInt2 : TGInt) : TCompare;
  69. Procedure GIntchangesign(Var GInt : TGInt);
  70. Procedure GIntabs(Var GInt : TGInt);
  71. Procedure GIntadd(GInt1, GInt2 : TGInt; Var sum : TGInt);
  72. Procedure GIntsub(GInt1, GInt2 : TGInt; Var dif : TGInt);
  73. Procedure GIntmul(GInt1, GInt2 : TGInt; Var prod : TGInt);
  74. Procedure GIntMulByInt(GInt1 : TGInt; By : Longint; Var prod : TGInt);
  75. Procedure GIntMulByIntBis(Var GInt : TGInt; By : Longint);
  76. Procedure GIntSquare(GInt : TGInt; Var Square : TGInt);
  77. Procedure GInttobinstr(GInt : TGint; Var S : String);
  78. Procedure Binstrtogint(S : String; Var GInt : TGInt);
  79. Procedure GInttostr(GInt : TGInt; Var str : String);
  80. Procedure strtoGInt(str : String; Var GInt : TGInt);
  81. Procedure GIntExp(GInt, exp : TGInt; Var res : TGInt);
  82. Procedure GIntfac(GInt : TGInt; Var res : TGint);
  83. Procedure GIntdivmod(GInt1, GInt2 : TGInt; Var divres, modres : TGInt);
  84. Procedure GIntdiv(GInt1, GInt2 : TGInt; Var divres : TGInt);
  85. Procedure GIntmod(GInt1, GInt2 : TGInt; Var modres : TGInt);
  86. Procedure GIntSquareMod(GInt, Modb : TGInt; Var GIntSM : TGInt);
  87. Procedure GIntAddMod(GInt1, GInt2, base : TGInt; Var GIntres : TGInt);
  88. Procedure GIntMulMod(GInt1, GInt2, base : TGInt; Var GIntres : TGInt);
  89. Procedure GIntmodExp(GInt, exp, modb : TGInt; Var res : TGInt);
  90. Procedure GIntGCD(GInt1, GInt2 : TGint; Var GCD : TGInt);
  91. Procedure GIntLCM(GInt1, GInt2 : TGInt; Var LCM : TGInt);
  92. Procedure GIntTrialdiv9999(GInt : TGInt; Var ok : boolean);
  93. Procedure GIntRandom1(Seed : TGInt; Var RandomGInt : TGInt);
  94. Procedure GIntRabinMiller(GIntp : TGInt; nrtest : integer; Var ok : boolean);
  95. Procedure GIntBezoutBachet(GInt1, GInt2 : TGInt; Var a, b : TGInt);
  96. Procedure GIntModInv(GInt1, base : TGInt; Var Inverse : TGInt);
  97. Procedure GIntPrimetest(GIntp : TGInt; nrRMtests : integer; Var ok : boolean);
  98. Procedure GIntLegendreSymbol(a, p : TGInt; Var L : integer);
  101. Implementation
  103. Var
  104.    primes : Array[1..1227] Of integer =
  105.       (3, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97, 101, 103, 107, 109, 113, 127,
  106.       131, 137, 139, 149, 151, 157, 163, 167, 173, 179, 181, 191, 193, 197, 199, 211, 223, 227, 229, 233, 239, 241, 251,
  107.       257, 263, 269, 271, 277, 281, 283, 293, 307, 311, 313, 317, 331, 337, 347, 349, 353, 359, 367, 373, 379, 383, 389,
  108.       397, 401, 409, 419, 421, 431, 433, 439, 443, 449, 457, 461, 463, 467, 479, 487, 491, 499, 503, 509, 521, 523, 541,
  109.       547, 557, 563, 569, 571, 577, 587, 593, 599, 601, 607, 613, 617, 619, 631, 641, 643, 647, 653, 659, 661, 673, 677,
  110.       683, 691, 701, 709, 719, 727, 733, 739, 743, 751, 757, 761, 769, 773, 787, 797, 809, 811, 821, 823, 827, 829, 839,
  111.       853, 857, 859, 863, 877, 881, 883, 887, 907, 911, 919, 929, 937, 941, 947, 953, 967, 971, 977, 983, 991, 997, 1009,
  112.       1013, 1019, 1021, 1031, 1033, 1039, 1049, 1051, 1061, 1063, 1069, 1087, 1091, 1093, 1097, 1103, 1109, 1117, 1123,
  113.       1129, 1151, 1153, 1163, 1171, 1181, 1187, 1193, 1201, 1213, 1217, 1223, 1229, 1231, 1237, 1249, 1259, 1277, 1279,
  114.       1283, 1289, 1291, 1297, 1301, 1303, 1307, 1319, 1321, 1327, 1361, 1367, 1373, 1381, 1399, 1409, 1423, 1427, 1429,
  115.       1433, 1439, 1447, 1451, 1453, 1459, 1471, 1481, 1483, 1487, 1489, 1493, 1499, 1511, 1523, 1531, 1543, 1549, 1553,
  116.       1559, 1567, 1571, 1579, 1583, 1597, 1601, 1607, 1609, 1613, 1619, 1621, 1627, 1637, 1657, 1663, 1667, 1669, 1693,
  117.       1697, 1699, 1709, 1721, 1723, 1733, 1741, 1747, 1753, 1759, 1777, 1783, 1787, 1789, 1801, 1811, 1823, 1831, 1847,
  118.       1861, 1867, 1871, 1873, 1877, 1879, 1889, 1901, 1907, 1913, 1931, 1933, 1949, 1951, 1973, 1979, 1987, 1993, 1997,
  119.       1999, 2003, 2011, 2017, 2027, 2029, 2039, 2053, 2063, 2069, 2081, 2083, 2087, 2089, 2099, 2111, 2113, 2129, 2131,
  120.       2137, 2141, 2143, 2153, 2161, 2179, 2203, 2207, 2213, 2221, 2237, 2239, 2243, 2251, 2267, 2269, 2273, 2281, 2287,
  121.       2293, 2297, 2309, 2311, 2333, 2339, 2341, 2347, 2351, 2357, 2371, 2377, 2381, 2383, 2389, 2393, 2399, 2411, 2417,
  122.       2423, 2437, 2441, 2447, 2459, 2467, 2473, 2477, 2503, 2521, 2531, 2539, 2543, 2549, 2551, 2557, 2579, 2591, 2593,
  123.       2609, 2617, 2621, 2633, 2647, 2657, 2659, 2663, 2671, 2677, 2683, 2687, 2689, 2693, 2699, 2707, 2711, 2713, 2719,
  124.       2729, 2731, 2741, 2749, 2753, 2767, 2777, 2789, 2791, 2797, 2801, 2803, 2819, 2833, 2837, 2843, 2851, 2857, 2861,
  125.       2879, 2887, 2897, 2903, 2909, 2917, 2927, 2939, 2953, 2957, 2963, 2969, 2971, 2999, 3001, 3011, 3019, 3023, 3037,
  126.       3041, 3049, 3061, 3067, 3079, 3083, 3089, 3109, 3119, 3121, 3137, 3163, 3167, 3169, 3181, 3187, 3191, 3203, 3209,
  127.       3217, 3221, 3229, 3251, 3253, 3257, 3259, 3271, 3299, 3301, 3307, 3313, 3319, 3323, 3329, 3331, 3343, 3347, 3359,
  128.       3361, 3371, 3373, 3389, 3391, 3407, 3413, 3433, 3449, 3457, 3461, 3463, 3467, 3469, 3491, 3499, 3511, 3517, 3527,
  129.       3529, 3533, 3539, 3541, 3547, 3557, 3559, 3571, 3581, 3583, 3593, 3607, 3613, 3617, 3623, 3631, 3637, 3643, 3659,
  130.       3671, 3673, 3677, 3691, 3697, 3701, 3709, 3719, 3727, 3733, 3739, 3761, 3767, 3769, 3779, 3793, 3797, 3803, 3821,
  131.       3823, 3833, 3847, 3851, 3853, 3863, 3877, 3881, 3889, 3907, 3911, 3917, 3919, 3923, 3929, 3931, 3943, 3947, 3967,
  132.       3989, 4001, 4003, 4007, 4013, 4019, 4021, 4027, 4049, 4051, 4057, 4073, 4079, 4091, 4093, 4099, 4111, 4127, 4129,
  133.       4133, 4139, 4153, 4157, 4159, 4177, 4201, 4211, 4217, 4219, 4229, 4231, 4241, 4243, 4253, 4259, 4261, 4271, 4273,
  134.       4283, 4289, 4297, 4327, 4337, 4339, 4349, 4357, 4363, 4373, 4391, 4397, 4409, 4421, 4423, 4441, 4447, 4451, 4457,
  135.       4463, 4481, 4483, 4493, 4507, 4513, 4517, 4519, 4523, 4547, 4549, 4561, 4567, 4583, 4591, 4597, 4603, 4621, 4637,
  136.       4639, 4643, 4649, 4651, 4657, 4663, 4673, 4679, 4691, 4703, 4721, 4723, 4729, 4733, 4751, 4759, 4783, 4787, 4789,
  137.       4793, 4799, 4801, 4813, 4817, 4831, 4861, 4871, 4877, 4889, 4903, 4909, 4919, 4931, 4933, 4937, 4943, 4951, 4957,
  138.       4967, 4969, 4973, 4987, 4993, 4999, 5003, 5009, 5011, 5021, 5023, 5039, 5051, 5059, 5077, 5081, 5087, 5099, 5101,
  139.       5107, 5113, 5119, 5147, 5153, 5167, 5171, 5179, 5189, 5197, 5209, 5227, 5231, 5233, 5237, 5261, 5273, 5279, 5281,
  140.       5297, 5303, 5309, 5323, 5333, 5347, 5351, 5381, 5387, 5393, 5399, 5407, 5413, 5417, 5419, 5431, 5437, 5441, 5443,
  141.       5449, 5471, 5477, 5479, 5483, 5501, 5503, 5507, 5519, 5521, 5527, 5531, 5557, 5563, 5569, 5573, 5581, 5591, 5623,
  142.       5639, 5641, 5647, 5651, 5653, 5657, 5659, 5669, 5683, 5689, 5693, 5701, 5711, 5717, 5737, 5741, 5743, 5749, 5779,
  143.       5783, 5791, 5801, 5807, 5813, 5821, 5827, 5839, 5843, 5849, 5851, 5857, 5861, 5867, 5869, 5879, 5881, 5897, 5903,
  144.       5923, 5927, 5939, 5953, 5981, 5987, 6007, 6011, 6029, 6037, 6043, 6047, 6053, 6067, 6073, 6079, 6089, 6091, 6101,
  145.       6113, 6121, 6131, 6133, 6143, 6151, 6163, 6173, 6197, 6199, 6203, 6211, 6217, 6221, 6229, 6247, 6257, 6263, 6269,
  146.       6271, 6277, 6287, 6299, 6301, 6311, 6317, 6323, 6329, 6337, 6343, 6353, 6359, 6361, 6367, 6373, 6379, 6389, 6397,
  147.       6421, 6427, 6449, 6451, 6469, 6473, 6481, 6491, 6521, 6529, 6547, 6551, 6553, 6563, 6569, 6571, 6577, 6581, 6599,
  148.       6607, 6619, 6637, 6653, 6659, 6661, 6673, 6679, 6689, 6691, 6701, 6703, 6709, 6719, 6733, 6737, 6761, 6763, 6779,
  149.       6781, 6791, 6793, 6803, 6823, 6827, 6829, 6833, 6841, 6857, 6863, 6869, 6871, 6883, 6899, 6907, 6911, 6917, 6947,
  150.       6949, 6959, 6961, 6967, 6971, 6977, 6983, 6991, 6997, 7001, 7013, 7019, 7027, 7039, 7043, 7057, 7069, 7079, 7103,
  151.       7109, 7121, 7127, 7129, 7151, 7159, 7177, 7187, 7193, 7207, 7211, 7213, 7219, 7229, 7237, 7243, 7247, 7253, 7283,
  152.       7297, 7307, 7309, 7321, 7331, 7333, 7349, 7351, 7369, 7393, 7411, 7417, 7433, 7451, 7457, 7459, 7477, 7481, 7487,
  153.       7489, 7499, 7507, 7517, 7523, 7529, 7537, 7541, 7547, 7549, 7559, 7561, 7573, 7577, 7583, 7589, 7591, 7603, 7607,
  154.       7621, 7639, 7643, 7649, 7669, 7673, 7681, 7687, 7691, 7699, 7703, 7717, 7723, 7727, 7741, 7753, 7757, 7759, 7789,
  155.       7793, 7817, 7823, 7829, 7841, 7853, 7867, 7873, 7877, 7879, 7883, 7901, 7907, 7919, 7927, 7933, 7937, 7949, 7951,
  156.       7963, 7993, 8009, 8011, 8017, 8039, 8053, 8059, 8069, 8081, 8087, 8089, 8093, 8101, 8111, 8117, 8123, 8147, 8161,
  157.       8167, 8171, 8179, 8191, 8209, 8219, 8221, 8231, 8233, 8237, 8243, 8263, 8269, 8273, 8287, 8291, 8293, 8297, 8311,
  158.       8317, 8329, 8353, 8363, 8369, 8377, 8387, 8389, 8419, 8423, 8429, 8431, 8443, 8447, 8461, 8467, 8501, 8513, 8521,
  159.       8527, 8537, 8539, 8543, 8563, 8573, 8581, 8597, 8599, 8609, 8623, 8627, 8629, 8641, 8647, 8663, 8669, 8677, 8681,
  160.       8689, 8693, 8699, 8707, 8713, 8719, 8731, 8737, 8741, 8747, 8753, 8761, 8779, 8783, 8803, 8807, 8819, 8821, 8831,
  161.       8837, 8839, 8849, 8861, 8863, 8867, 8887, 8893, 8923, 8929, 8933, 8941, 8951, 8963, 8969, 8971, 8999, 9001, 9007,
  162.       9011, 9013, 9029, 9041, 9043, 9049, 9059, 9067, 9091, 9103, 9109, 9127, 9133, 9137, 9151, 9157, 9161, 9173, 9181,
  163.       9187, 9199, 9203, 9209, 9221, 9227, 9239, 9241, 9257, 9277, 9281, 9283, 9293, 9311, 9319, 9323, 9337, 9341, 9343,
  164.       9349, 9371, 9377, 9391, 9397, 9403, 9413, 9419, 9421, 9431, 9433, 9437, 9439, 9461, 9463, 9467, 9473, 9479, 9491,
  165.       9497, 9511, 9521, 9533, 9539, 9547, 9551, 9587, 9601, 9613, 9619, 9623, 9629, 9631, 9643, 9649, 9661, 9677, 9679,
  166.       9689, 9697, 9719, 9721, 9733, 9739, 9743, 9749, 9767, 9769, 9781, 9787, 9791, 9803, 9811, 9817, 9829, 9833, 9839,
  167.       9851, 9857, 9859, 9871, 9883, 9887, 9901, 9907, 9923, 9929, 9931, 9941, 9949, 9967, 9973);
  168.    chr64 : Array[1..64] Of char = ('a', 'A', 'b', 'B', 'c', 'C', 'd', 'D', 'e', 'E', 'f', 'F',
  169.       'g', 'G', 'h', 'H', 'i', 'I', 'j', 'J', 'k', 'K', 'l', 'L', 'm', 'M', 'n', 'N', 'o', 'O', 'p',
  170.       'P', 'q', 'Q', 'r', 'R', 's', 'S', 't', 'T', 'u', 'U', 'v', 'V', 'w', 'W', 'x', 'X', 'y', 'Y',
  171.       'z', 'Z', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '+', '=');
  173. {$H+}
  176. Procedure zeronetochar8(Var g : char; x : String);
  177. Begin
  178.    If x[1] = '0' Then
  179.    Begin
  180.       If x[2] = '0' Then
  181.       Begin
  182.          If x[3] = '0' Then
  183.          Begin
  184.             If x[4] = '0' Then
  185.             Begin
  186.                If x[5] = '0' Then
  187.                Begin
  188.                   If x[6] = '0' Then
  189.                   Begin
  190.                      If x[7] = '0' Then
  191.                      Begin
  192.                         If x[8] = '0' Then g := chr(1) Else g := chr(2);
  193.                      End
  194.                      Else
  195.                      Begin
  196.                         If x[8] = '0' Then g := chr(4) Else g := chr(3);
  197.                      End
  198.                   End
  199.                   Else
  200.                   Begin
  201.                      If x[7] = '0' Then
  202.                      Begin
  203.                         If x[8] = '0' Then g := chr(5) Else g := chr(6);
  204.                      End
  205.                      Else
  206.                      Begin
  207.                         If x[8] = '0' Then g := chr(9) Else g := chr(8);
  208.                      End
  209.                   End
  210.                End
  211.                Else
  212.                Begin
  213.                   If x[6] = '0' Then
  214.                   Begin
  215.                      If x[7] = '0' Then
  216.                      Begin
  217.                         If x[8] = '0' Then g := chr(7) Else g := chr(10);
  218.                      End
  219.                      Else
  220.                      Begin
  221.                         If x[8] = '0' Then g := chr(11) Else g := chr(13);
  222.                      End
  223.                   End
  224.                   Else
  225.                   Begin
  226.                      If x[7] = '0' Then
  227.                      Begin
  228.                         If x[8] = '0' Then g := chr(14) Else g := chr(12);
  229.                      End
  230.                      Else
  231.                      Begin
  232.                         If x[8] = '0' Then g := chr(15) Else g := chr(16);
  233.                      End
  234.                   End
  235.                End
  236.             End
  237.             Else
  238.             Begin
  239.                If x[5] = '0' Then
  240.                Begin
  241.                   If x[6] = '0' Then
  242.                   Begin
  243.                      If x[7] = '0' Then
  244.                      Begin
  245.                         If x[8] = '0' Then g := chr(18) Else g := chr(20);
  246.                      End
  247.                      Else
  248.                      Begin
  249.                         If x[8] = '0' Then g := chr(17) Else g := chr(21);
  250.                      End
  251.                   End
  252.                   Else
  253.                   Begin
  254.                      If x[7] = '0' Then
  255.                      Begin
  256.                         If x[8] = '0' Then g := chr(19) Else g := chr(25);
  257.                      End
  258.                      Else
  259.                      Begin
  260.                         If x[8] = '0' Then g := chr(24) Else g := chr(22);
  261.                      End
  262.                   End
  263.                End
  264.                Else
  265.                Begin
  266.                   If x[6] = '0' Then
  267.                   Begin
  268.                      If x[7] = '0' Then
  269.                      Begin
  270.                         If x[8] = '0' Then g := chr(23) Else g := chr(26);
  271.                      End
  272.                      Else
  273.                      Begin
  274.                         If x[8] = '0' Then g := chr(28) Else g := chr(31);
  275.                      End
  276.                   End
  277.                   Else
  278.                   Begin
  279.                      If x[7] = '0' Then
  280.                      Begin
  281.                         If x[8] = '0' Then g := chr(27) Else g := chr(29);
  282.                      End
  283.                      Else
  284.                      Begin
  285.                         If x[8] = '0' Then g := chr(30) Else g := chr(32);
  286.                      End
  287.                   End
  288.                End
  289.             End
  290.          End
  291.          Else
  292.          Begin
  293.             If x[4] = '0' Then
  294.             Begin
  295.                If x[5] = '0' Then
  296.                Begin
  297.                   If x[6] = '0' Then
  298.                   Begin
  299.                      If x[7] = '0' Then
  300.                      Begin
  301.                         If x[8] = '0' Then g := chr(0) Else g := chr(33);
  302.                      End
  303.                      Else
  304.                      Begin
  305.                         If x[8] = '0' Then g := chr(34) Else g := chr(36);
  306.                      End
  307.                   End
  308.                   Else
  309.                   Begin
  310.                      If x[7] = '0' Then
  311.                      Begin
  312.                         If x[8] = '0' Then g := chr(35) Else g := chr(37);
  313.                      End
  314.                      Else
  315.                      Begin
  316.                         If x[8] = '0' Then g := chr(38) Else g := chr(40);
  317.                      End
  318.                   End
  319.                End
  320.                Else
  321.                Begin
  322.                   If x[6] = '0' Then
  323.                   Begin
  324.                      If x[7] = '0' Then
  325.                      Begin
  326.                         If x[8] = '0' Then g := chr(39) Else g := chr(41);
  327.                      End
  328.                      Else
  329.                      Begin
  330.                         If x[8] = '0' Then g := chr(42) Else g := chr(43);
  331.                      End
  332.                   End
  333.                   Else
  334.                   Begin
  335.                      If x[7] = '0' Then
  336.                      Begin
  337.                         If x[8] = '0' Then g := chr(44) Else g := chr(45);
  338.                      End
  339.                      Else
  340.                      Begin
  341.                         If x[8] = '0' Then g := chr(46) Else g := chr(47);
  342.                      End
  343.                   End
  344.                End
  345.             End
  346.             Else
  347.             Begin
  348.                If x[5] = '0' Then
  349.                Begin
  350.                   If x[6] = '0' Then
  351.                   Begin
  352.                      If x[7] = '0' Then
  353.                      Begin
  354.                         If x[8] = '0' Then g := chr(48) Else g := chr(49);
  355.                      End
  356.                      Else
  357.                      Begin
  358.                         If x[8] = '0' Then g := chr(50) Else g := chr(51);
  359.                      End
  360.                   End
  361.                   Else
  362.                   Begin
  363.                      If x[7] = '0' Then
  364.                      Begin
  365.                         If x[8] = '0' Then g := chr(52) Else g := chr(53);
  366.                      End
  367.                      Else
  368.                      Begin
  369.                         If x[8] = '0' Then g := chr(54) Else g := chr(55);
  370.                      End
  371.                   End
  372.                End
  373.                Else
  374.                Begin
  375.                   If x[6] = '0' Then
  376.                   Begin
  377.                      If x[7] = '0' Then
  378.                      Begin
  379.                         If x[8] = '0' Then g := chr(56) Else g := chr(57);
  380.                      End
  381.                      Else
  382.                      Begin
  383.                         If x[8] = '0' Then g := chr(58) Else g := chr(59);
  384.                      End
  385.                   End
  386.                   Else
  387.                   Begin
  388.                      If x[7] = '0' Then
  389.                      Begin
  390.                         If x[8] = '0' Then g := chr(60) Else g := chr(90);
  391.                      End
  392.                      Else
  393.                      Begin
  394.                         If x[8] = '0' Then g := chr(89) Else g := chr(88);
  395.                      End
  396.                   End
  397.                End
  398.             End
  399.          End
  400.       End
  401.       Else
  402.       Begin
  403.          If x[3] = '0' Then
  404.          Begin
  405.             If x[4] = '0' Then
  406.             Begin
  407.                If x[5] = '0' Then
  408.                Begin
  409.                   If x[6] = '0' Then
  410.                   Begin
  411.                      If x[7] = '0' Then
  412.                      Begin
  413.                         If x[8] = '0' Then g := chr(87) Else g := chr(86);
  414.                      End
  415.                      Else
  416.                      Begin
  417.                         If x[8] = '0' Then g := chr(85) Else g := chr(84);
  418.                      End
  419.                   End
  420.                   Else
  421.                   Begin
  422.                      If x[7] = '0' Then
  423.                      Begin
  424.                         If x[8] = '0' Then g := chr(83) Else g := chr(82);
  425.                      End
  426.                      Else
  427.                      Begin
  428.                         If x[8] = '0' Then g := chr(81) Else g := chr(80);
  429.                      End
  430.                   End
  431.                End
  432.                Else
  433.                Begin
  434.                   If x[6] = '0' Then
  435.                   Begin
  436.                      If x[7] = '0' Then
  437.                      Begin
  438.                         If x[8] = '0' Then g := chr(79) Else g := chr(78);
  439.                      End
  440.                      Else
  441.                      Begin
  442.                         If x[8] = '0' Then g := chr(77) Else g := chr(76);
  443.                      End
  444.                   End
  445.                   Else
  446.                   Begin
  447.                      If x[7] = '0' Then
  448.                      Begin
  449.                         If x[8] = '0' Then g := chr(75) Else g := chr(74);
  450.                      End
  451.                      Else
  452.                      Begin
  453.                         If x[8] = '0' Then g := chr(73) Else g := chr(72);
  454.                      End
  455.                   End
  456.                End
  457.             End
  458.             Else
  459.             Begin
  460.                If x[5] = '0' Then
  461.                Begin
  462.                   If x[6] = '0' Then
  463.                   Begin
  464.                      If x[7] = '0' Then
  465.                      Begin
  466.                         If x[8] = '0' Then g := chr(71) Else g := chr(70);
  467.                      End
  468.                      Else
  469.                      Begin
  470.                         If x[8] = '0' Then g := chr(69) Else g := chr(68);
  471.                      End
  472.                   End
  473.                   Else
  474.                   Begin
  475.                      If x[7] = '0' Then
  476.                      Begin
  477.                         If x[8] = '0' Then g := chr(67) Else g := chr(66);
  478.                      End
  479.                      Else
  480.                      Begin
  481.                         If x[8] = '0' Then g := chr(65) Else g := chr(64);
  482.                      End
  483.                   End
  484.                End
  485.                Else
  486.                Begin
  487.                   If x[6] = '0' Then
  488.                   Begin
  489.                      If x[7] = '0' Then
  490.                      Begin
  491.                         If x[8] = '0' Then g := chr(63) Else g := chr(62);
  492.                      End
  493.                      Else
  494.                      Begin
  495.                         If x[8] = '0' Then g := chr(61) Else g := chr(95);
  496.                      End
  497.                   End
  498.                   Else
  499.                   Begin
  500.                      If x[7] = '0' Then
  501.                      Begin
  502.                         If x[8] = '0' Then g := chr(94) Else g := chr(93);
  503.                      End
  504.                      Else
  505.                      Begin
  506.                         If x[8] = '0' Then g := chr(91) Else g := chr(92);
  507.                      End
  508.                   End
  509.                End
  510.             End
  511.          End
  512.          Else
  513.          Begin
  514.             If x[4] = '0' Then
  515.             Begin
  516.                If x[5] = '0' Then
  517.                Begin
  518.                   If x[6] = '0' Then
  519.                   Begin
  520.                      If x[7] = '0' Then
  521.                      Begin
  522.                         If x[8] = '0' Then g := chr(96) Else g := chr(97);
  523.                      End
  524.                      Else
  525.                      Begin
  526.                         If x[8] = '0' Then g := chr(98) Else g := chr(99);
  527.                      End
  528.                   End
  529.                   Else
  530.                   Begin
  531.                      If x[7] = '0' Then
  532.                      Begin
  533.                         If x[8] = '0' Then g := chr(100) Else g := chr(101);
  534.                      End
  535.                      Else
  536.                      Begin
  537.                         If x[8] = '0' Then g := chr(102) Else g := chr(105);
  538.                      End
  539.                   End
  540.                End
  541.                Else
  542.                Begin
  543.                   If x[6] = '0' Then
  544.                   Begin
  545.                      If x[7] = '0' Then
  546.                      Begin
  547.                         If x[8] = '0' Then g := chr(103) Else g := chr(104);
  548.                      End
  549.                      Else
  550.                      Begin
  551.                         If x[8] = '0' Then g := chr(106) Else g := chr(107);
  552.                      End
  553.                   End
  554.                   Else
  555.                   Begin
  556.                      If x[7] = '0' Then
  557.                      Begin
  558.                         If x[8] = '0' Then g := chr(108) Else g := chr(109);
  559.                      End
  560.                      Else
  561.                      Begin
  562.                         If x[8] = '0' Then g := chr(110) Else g := chr(111);
  563.                      End
  564.                   End
  565.                End
  566.             End
  567.             Else
  568.             Begin
  569.                If x[5] = '0' Then
  570.                Begin
  571.                   If x[6] = '0' Then
  572.                   Begin
  573.                      If x[7] = '0' Then
  574.                      Begin
  575.                         If x[8] = '0' Then g := chr(112) Else g := chr(113);
  576.                      End
  577.                      Else
  578.                      Begin
  579.                         If x[8] = '0' Then g := chr(114) Else g := chr(115);
  580.                      End
  581.                   End
  582.                   Else
  583.                   Begin
  584.                      If x[7] = '0' Then
  585.                      Begin
  586.                         If x[8] = '0' Then g := chr(116) Else g := chr(117);
  587.                      End
  588.                      Else
  589.                      Begin
  590.                         If x[8] = '0' Then g := chr(118) Else g := chr(119);
  591.                      End
  592.                   End
  593.                End
  594.                Else
  595.                Begin
  596.                   If x[6] = '0' Then
  597.                   Begin
  598.                      If x[7] = '0' Then
  599.                      Begin
  600.                         If x[8] = '0' Then g := chr(120) Else g := chr(121);
  601.                      End
  602.                      Else
  603.                      Begin
  604.                         If x[8] = '0' Then g := chr(125) Else g := chr(124);
  605.                      End
  606.                   End
  607.                   Else
  608.                   Begin
  609.                      If x[7] = '0' Then
  610.                      Begin
  611.                         If x[8] = '0' Then g := chr(123) Else g := chr(126);
  612.                      End
  613.                      Else
  614.                      Begin
  615.                         If x[8] = '0' Then g := chr(122) Else g := chr(127);
  616.                      End
  617.                   End
  618.                End
  619.             End
  620.          End
  621.       End
  622.    End
  623.    Else
  624.    Begin
  625.       If x[2] = '0' Then
  626.       Begin
  627.          If x[3] = '0' Then
  628.          Begin
  629.             If x[4] = '0' Then
  630.             Begin
  631.                If x[5] = '0' Then
  632.                Begin
  633.                   If x[6] = '0' Then
  634.                   Begin
  635.                      If x[7] = '0' Then
  636.                      Begin
  637.                         If x[8] = '0' Then g := chr(128) Else g := chr(130);
  638.                      End
  639.                      Else
  640.                      Begin
  641.                         If x[8] = '0' Then g := chr(129) Else g := chr(131);
  642.                      End
  643.                   End
  644.                   Else
  645.                   Begin
  646.                      If x[7] = '0' Then
  647.                      Begin
  648.                         If x[8] = '0' Then g := chr(132) Else g := chr(133);
  649.                      End
  650.                      Else
  651.                      Begin
  652.                         If x[8] = '0' Then g := chr(134) Else g := chr(135);
  653.                      End
  654.                   End
  655.                End
  656.                Else
  657.                Begin
  658.                   If x[6] = '0' Then
  659.                   Begin
  660.                      If x[7] = '0' Then
  661.                      Begin
  662.                         If x[8] = '0' Then g := chr(136) Else g := chr(137);
  663.                      End
  664.                      Else
  665.                      Begin
  666.                         If x[8] = '0' Then g := chr(138) Else g := chr(139);
  667.                      End
  668.                   End
  669.                   Else
  670.                   Begin
  671.                      If x[7] = '0' Then
  672.                      Begin
  673.                         If x[8] = '0' Then g := chr(140) Else g := chr(141);
  674.                      End
  675.                      Else
  676.                      Begin
  677.                         If x[8] = '0' Then g := chr(142) Else g := chr(143);
  678.                      End
  679.                   End
  680.                End
  681.             End
  682.             Else
  683.             Begin
  684.                If x[5] = '0' Then
  685.                Begin
  686.                   If x[6] = '0' Then
  687.                   Begin
  688.                      If x[7] = '0' Then
  689.                      Begin
  690.                         If x[8] = '0' Then g := chr(144) Else g := chr(145);
  691.                      End
  692.                      Else
  693.                      Begin
  694.                         If x[8] = '0' Then g := chr(150) Else g := chr(149);
  695.                      End
  696.                   End
  697.                   Else
  698.                   Begin
  699.                      If x[7] = '0' Then
  700.                      Begin
  701.                         If x[8] = '0' Then g := chr(148) Else g := chr(147);
  702.                      End
  703.                      Else
  704.                      Begin
  705.                         If x[8] = '0' Then g := chr(146) Else g := chr(151);
  706.                      End
  707.                   End
  708.                End
  709.                Else
  710.                Begin
  711.                   If x[6] = '0' Then
  712.                   Begin
  713.                      If x[7] = '0' Then
  714.                      Begin
  715.                         If x[8] = '0' Then g := chr(152) Else g := chr(154);
  716.                      End
  717.                      Else
  718.                      Begin
  719.                         If x[8] = '0' Then g := chr(153) Else g := chr(155);
  720.                      End
  721.                   End
  722.                   Else
  723.                   Begin
  724.                      If x[7] = '0' Then
  725.                      Begin
  726.                         If x[8] = '0' Then g := chr(156) Else g := chr(157);
  727.                      End
  728.                      Else
  729.                      Begin
  730.                         If x[8] = '0' Then g := chr(158) Else g := chr(159);
  731.                      End
  732.                   End
  733.                End
  734.             End
  735.          End
  736.          Else
  737.          Begin
  738.             If x[4] = '0' Then
  739.             Begin
  740.                If x[5] = '0' Then
  741.                Begin
  742.                   If x[6] = '0' Then
  743.                   Begin
  744.                      If x[7] = '0' Then
  745.                      Begin
  746.                         If x[8] = '0' Then g := chr(160) Else g := chr(161);
  747.                      End
  748.                      Else
  749.                      Begin
  750.                         If x[8] = '0' Then g := chr(162) Else g := chr(170);
  751.                      End
  752.                   End
  753.                   Else
  754.                   Begin
  755.                      If x[7] = '0' Then
  756.                      Begin
  757.                         If x[8] = '0' Then g := chr(165) Else g := chr(166);
  758.                      End
  759.                      Else
  760.                      Begin
  761.                         If x[8] = '0' Then g := chr(167) Else g := chr(168);
  762.                      End
  763.                   End
  764.                End
  765.                Else
  766.                Begin
  767.                   If x[6] = '0' Then
  768.                   Begin
  769.                      If x[7] = '0' Then
  770.                      Begin
  771.                         If x[8] = '0' Then g := chr(169) Else g := chr(163);
  772.                      End
  773.                      Else
  774.                      Begin
  775.                         If x[8] = '0' Then g := chr(164) Else g := chr(171);
  776.                      End
  777.                   End
  778.                   Else
  779.                   Begin
  780.                      If x[7] = '0' Then
  781.                      Begin
  782.                         If x[8] = '0' Then g := chr(172) Else g := chr(173);
  783.                      End
  784.                      Else
  785.                      Begin
  786.                         If x[8] = '0' Then g := chr(174) Else g := chr(175);
  787.                      End
  788.                   End
  789.                End
  790.             End
  791.             Else
  792.             Begin
  793.                If x[5] = '0' Then
  794.                Begin
  795.                   If x[6] = '0' Then
  796.                   Begin
  797.                      If x[7] = '0' Then
  798.                      Begin
  799.                         If x[8] = '0' Then g := chr(176) Else g := chr(177);
  800.                      End
  801.                      Else
  802.                      Begin
  803.                         If x[8] = '0' Then g := chr(178) Else g := chr(179);
  804.                      End
  805.                   End
  806.                   Else
  807.                   Begin
  808.                      If x[7] = '0' Then
  809.                      Begin
  810.                         If x[8] = '0' Then g := chr(180) Else g := chr(181);
  811.                      End
  812.                      Else
  813.                      Begin
  814.                         If x[8] = '0' Then g := chr(200) Else g := chr(199);
  815.                      End
  816.                   End
  817.                End
  818.                Else
  819.                Begin
  820.                   If x[6] = '0' Then
  821.                   Begin
  822.                      If x[7] = '0' Then
  823.                      Begin
  824.                         If x[8] = '0' Then g := chr(198) Else g := chr(197);
  825.                      End
  826.                      Else
  827.                      Begin
  828.                         If x[8] = '0' Then g := chr(196) Else g := chr(195);
  829.                      End
  830.                   End
  831.                   Else
  832.                   Begin
  833.                      If x[7] = '0' Then
  834.                      Begin
  835.                         If x[8] = '0' Then g := chr(194) Else g := chr(193);
  836.                      End
  837.                      Else
  838.                      Begin
  839.                         If x[8] = '0' Then g := chr(192) Else g := chr(191);
  840.                      End
  841.                   End
  842.                End
  843.             End
  844.          End
  845.       End
  846.       Else
  847.       Begin
  848.          If x[3] = '0' Then
  849.          Begin
  850.             If x[4] = '0' Then
  851.             Begin
  852.                If x[5] = '0' Then
  853.                Begin
  854.                   If x[6] = '0' Then
  855.                   Begin
  856.                      If x[7] = '0' Then
  857.                      Begin
  858.                         If x[8] = '0' Then g := chr(190) Else g := chr(189);
  859.                      End
  860.                      Else
  861.                      Begin
  862.                         If x[8] = '0' Then g := chr(188) Else g := chr(182);
  863.                      End
  864.                   End
  865.                   Else
  866.                   Begin
  867.                      If x[7] = '0' Then
  868.                      Begin
  869.                         If x[8] = '0' Then g := chr(183) Else g := chr(184);
  870.                      End
  871.                      Else
  872.                      Begin
  873.                         If x[8] = '0' Then g := chr(185) Else g := chr(186);
  874.                      End
  875.                   End
  876.                End
  877.                Else
  878.                Begin
  879.                   If x[6] = '0' Then
  880.                   Begin
  881.                      If x[7] = '0' Then
  882.                      Begin
  883.                         If x[8] = '0' Then g := chr(187) Else g := chr(201);
  884.                      End
  885.                      Else
  886.                      Begin
  887.                         If x[8] = '0' Then g := chr(202) Else g := chr(203);
  888.                      End
  889.                   End
  890.                   Else
  891.                   Begin
  892.                      If x[7] = '0' Then
  893.                      Begin
  894.                         If x[8] = '0' Then g := chr(204) Else g := chr(205);
  895.                      End
  896.                      Else
  897.                      Begin
  898.                         If x[8] = '0' Then g := chr(206) Else g := chr(207);
  899.                      End
  900.                   End
  901.                End
  902.             End
  903.             Else
  904.             Begin
  905.                If x[5] = '0' Then
  906.                Begin
  907.                   If x[6] = '0' Then
  908.                   Begin
  909.                      If x[7] = '0' Then
  910.                      Begin
  911.                         If x[8] = '0' Then g := chr(208) Else g := chr(209);
  912.                      End
  913.                      Else
  914.                      Begin
  915.                         If x[8] = '0' Then g := chr(210) Else g := chr(220);
  916.                      End
  917.                   End
  918.                   Else
  919.                   Begin
  920.                      If x[7] = '0' Then
  921.                      Begin
  922.                         If x[8] = '0' Then g := chr(211) Else g := chr(219);
  923.                      End
  924.                      Else
  925.                      Begin
  926.                         If x[8] = '0' Then g := chr(212) Else g := chr(218);
  927.                      End
  928.                   End
  929.                End
  930.                Else
  931.                Begin
  932.                   If x[6] = '0' Then
  933.                   Begin
  934.                      If x[7] = '0' Then
  935.                      Begin
  936.                         If x[8] = '0' Then g := chr(213) Else g := chr(217);
  937.                      End
  938.                      Else
  939.                      Begin
  940.                         If x[8] = '0' Then g := chr(214) Else g := chr(216);
  941.                      End
  942.                   End
  943.                   Else
  944.                   Begin
  945.                      If x[7] = '0' Then
  946.                      Begin
  947.                         If x[8] = '0' Then g := chr(215) Else g := chr(221);
  948.                      End
  949.                      Else
  950.                      Begin
  951.                         If x[8] = '0' Then g := chr(222) Else g := chr(223);
  952.                      End
  953.                   End
  954.                End
  955.             End
  956.          End
  957.          Else
  958.          Begin
  959.             If x[4] = '0' Then
  960.             Begin
  961.                If x[5] = '0' Then
  962.                Begin
  963.                   If x[6] = '0' Then
  964.                   Begin
  965.                      If x[7] = '0' Then
  966.                      Begin
  967.                         If x[8] = '0' Then g := chr(224) Else g := chr(225);
  968.                      End
  969.                      Else
  970.                      Begin
  971.                         If x[8] = '0' Then g := chr(226) Else g := chr(227);
  972.                      End
  973.                   End
  974.                   Else
  975.                   Begin
  976.                      If x[7] = '0' Then
  977.                      Begin
  978.                         If x[8] = '0' Then g := chr(228) Else g := chr(229);
  979.                      End
  980.                      Else
  981.                      Begin
  982.                         If x[8] = '0' Then g := chr(230) Else g := chr(231);
  983.                      End
  984.                   End
  985.                End
  986.                Else
  987.                Begin
  988.                   If x[6] = '0' Then
  989.                   Begin
  990.                      If x[7] = '0' Then
  991.                      Begin
  992.                         If x[8] = '0' Then g := chr(232) Else g := chr(233);
  993.                      End
  994.                      Else
  995.                      Begin
  996.                         If x[8] = '0' Then g := chr(234) Else g := chr(235);
  997.                      End
  998.                   End
  999.                   Else
  1000.                   Begin
  1001.                      If x[7] = '0' Then
  1002.                      Begin
  1003.                         If x[8] = '0' Then g := chr(236) Else g := chr(237);
  1004.                      End
  1005.                      Else
  1006.                      Begin
  1007.                         If x[8] = '0' Then g := chr(238) Else g := chr(240);
  1008.                      End
  1009.                   End
  1010.                End
  1011.             End
  1012.             Else
  1013.             Begin
  1014.                If x[5] = '0' Then
  1015.                Begin
  1016.                   If x[6] = '0' Then
  1017.                   Begin
  1018.                      If x[7] = '0' Then
  1019.                      Begin
  1020.                         If x[8] = '0' Then g := chr(239) Else g := chr(241);
  1021.                      End
  1022.                      Else
  1023.                      Begin
  1024.                         If x[8] = '0' Then g := chr(242) Else g := chr(243);
  1025.                      End
  1026.                   End
  1027.                   Else
  1028.                   Begin
  1029.                      If x[7] = '0' Then
  1030.                      Begin
  1031.                         If x[8] = '0' Then g := chr(244) Else g := chr(245);
  1032.                      End
  1033.                      Else
  1034.                      Begin
  1035.                         If x[8] = '0' Then g := chr(255) Else g := chr(254);
  1036.                      End
  1037.                   End
  1038.                End
  1039.                Else
  1040.                Begin
  1041.                   If x[6] = '0' Then
  1042.                   Begin
  1043.                      If x[7] = '0' Then
  1044.                      Begin
  1045.                         If x[8] = '0' Then g := chr(246) Else g := chr(253);
  1046.                      End
  1047.                      Else
  1048.                      Begin
  1049.                         If x[8] = '0' Then g := chr(247) Else g := chr(252);
  1050.                      End
  1051.                   End
  1052.                   Else
  1053.                   Begin
  1054.                      If x[7] = '0' Then
  1055.                      Begin
  1056.                         If x[8] = '0' Then g := chr(248) Else g := chr(251);
  1057.                      End
  1058.                      Else
  1059.                      Begin
  1060.                         If x[8] = '0' Then g := chr(249) Else g := chr(250);
  1061.                      End
  1062.                   End
  1063.                End
  1064.             End
  1065.          End
  1066.       End
  1067.    End
  1068. End;
  1072. Procedure zeronetochar6(Var g : integer; x : String);
  1073. Begin
  1074.    If x[1] = '0' Then
  1075.    Begin
  1076.       If x[2] = '0' Then
  1077.       Begin
  1078.          If x[3] = '0' Then
  1079.          Begin
  1080.             If x[4] = '0' Then
  1081.             Begin
  1082.                If x[5] = '0' Then
  1083.                Begin
  1084.                   If x[6] = '0' Then g := 1 Else g := 2;
  1085.                End
  1086.                Else
  1087.                Begin
  1088.                   If x[6] = '0' Then g := 3 Else g := 4;
  1089.                End
  1090.             End
  1091.             Else
  1092.             Begin
  1093.                If x[5] = '0' Then
  1094.                Begin
  1095.                   If x[6] = '0' Then g := 5 Else g := 6;
  1096.                End
  1097.                Else
  1098.                Begin
  1099.                   If x[6] = '0' Then g := 7 Else g := 8;
  1100.                End
  1101.             End
  1102.          End
  1103.          Else
  1104.          Begin
  1105.             If x[4] = '0' Then
  1106.             Begin
  1107.                If x[5] = '0' Then
  1108.                Begin
  1109.                   If x[6] = '0' Then g := 9 Else g := 10;
  1110.                End
  1111.                Else
  1112.                Begin
  1113.                   If x[6] = '0' Then g := 11 Else g := 12;
  1114.                End
  1115.             End
  1116.             Else
  1117.             Begin
  1118.                If x[5] = '0' Then
  1119.                Begin
  1120.                   If x[6] = '0' Then g := 13 Else g := 14;
  1121.                End
  1122.                Else
  1123.                Begin
  1124.                   If x[6] = '0' Then g := 15 Else g := 16;
  1125.                End
  1126.             End
  1127.          End
  1128.       End
  1129.       Else
  1130.       Begin
  1131.          If x[3] = '0' Then
  1132.          Begin
  1133.             If x[4] = '0' Then
  1134.             Begin
  1135.                If x[5] = '0' Then
  1136.                Begin
  1137.                   If x[6] = '0' Then g := 17 Else g := 18;
  1138.                End
  1139.                Else
  1140.                Begin
  1141.                   If x[6] = '0' Then g := 19 Else g := 20;
  1142.                End
  1143.             End
  1144.             Else
  1145.             Begin
  1146.                If x[5] = '0' Then
  1147.                Begin
  1148.                   If x[6] = '0' Then g := 21 Else g := 22;
  1149.                End
  1150.                Else
  1151.                Begin
  1152.                   If x[6] = '0' Then g := 23 Else g := 24;
  1153.                End
  1154.             End
  1155.          End
  1156.          Else
  1157.          Begin
  1158.             If x[4] = '0' Then
  1159.             Begin
  1160.                If x[5] = '0' Then
  1161.                Begin
  1162.                   If x[6] = '0' Then g := 25 Else g := 26;
  1163.                End
  1164.                Else
  1165.                Begin
  1166.                   If x[6] = '0' Then g := 27 Else g := 28;
  1167.                End
  1168.             End
  1169.             Else
  1170.             Begin
  1171.                If x[5] = '0' Then
  1172.                Begin
  1173.                   If x[6] = '0' Then g := 29 Else g := 30;
  1174.                End
  1175.                Else
  1176.                Begin
  1177.                   If x[6] = '0' Then g := 31 Else g := 32;
  1178.                End
  1179.             End
  1180.          End
  1181.       End
  1182.    End
  1183.    Else
  1184.    Begin
  1185.       If x[2] = '0' Then
  1186.       Begin
  1187.          If x[3] = '0' Then
  1188.          Begin
  1189.             If x[4] = '0' Then
  1190.             Begin
  1191.                If x[5] = '0' Then
  1192.                Begin
  1193.                   If x[6] = '0' Then g := 33 Else g := 34;
  1194.                End
  1195.                Else
  1196.                Begin
  1197.                   If x[6] = '0' Then g := 35 Else g := 36;
  1198.                End
  1199.             End
  1200.             Else
  1201.             Begin
  1202.                If x[5] = '0' Then
  1203.                Begin
  1204.                   If x[6] = '0' Then g := 37 Else g := 38;
  1205.                End
  1206.                Else
  1207.                Begin
  1208.                   If x[6] = '0' Then g := 39 Else g := 40;
  1209.                End
  1210.             End
  1211.          End
  1212.          Else
  1213.          Begin
  1214.             If x[4] = '0' Then
  1215.             Begin
  1216.                If x[5] = '0' Then
  1217.                Begin
  1218.                   If x[6] = '0' Then g := 41 Else g := 42;
  1219.                End
  1220.                Else
  1221.                Begin
  1222.                   If x[6] = '0' Then g := 43 Else g := 44;
  1223.                End
  1224.             End
  1225.             Else
  1226.             Begin
  1227.                If x[5] = '0' Then
  1228.                Begin
  1229.                   If x[6] = '0' Then g := 45 Else g := 46;
  1230.                End
  1231.                Else
  1232.                Begin
  1233.                   If x[6] = '0' Then g := 47 Else g := 48;
  1234.                End
  1235.             End
  1236.          End
  1237.       End
  1238.       Else
  1239.       Begin
  1240.          If x[3] = '0' Then
  1241.          Begin
  1242.             If x[4] = '0' Then
  1243.             Begin
  1244.                If x[5] = '0' Then
  1245.                Begin
  1246.                   If x[6] = '0' Then g := 49 Else g := 50;
  1247.                End
  1248.                Else
  1249.                Begin
  1250.                   If x[6] = '0' Then g := 51 Else g := 52;
  1251.                End
  1252.             End
  1253.             Else
  1254.             Begin
  1255.                If x[5] = '0' Then
  1256.                Begin
  1257.                   If x[6] = '0' Then g := 53 Else g := 54;
  1258.                End
  1259.                Else
  1260.                Begin
  1261.                   If x[6] = '0' Then g := 55 Else g := 56;
  1262.                End
  1263.             End
  1264.          End
  1265.          Else
  1266.          Begin
  1267.             If x[4] = '0' Then
  1268.             Begin
  1269.                If x[5] = '0' Then
  1270.                Begin
  1271.                   If x[6] = '0' Then g := 57 Else g := 58;
  1272.                End
  1273.                Else
  1274.                Begin
  1275.                   If x[6] = '0' Then g := 59 Else g := 60;
  1276.                End
  1277.             End
  1278.             Else
  1279.             Begin
  1280.                If x[5] = '0' Then
  1281.                Begin
  1282.                   If x[6] = '0' Then g := 61 Else g := 62;
  1283.                End
  1284.                Else
  1285.                Begin
  1286.                   If x[6] = '0' Then g := 63 Else g := 64;
  1287.                End
  1288.             End
  1289.          End
  1290.       End
  1291.    End
  1292. End;
  1296. Procedure initialize8(Var trans : Array Of String);
  1297. Var
  1298.    c1, c2, c3, c4, c5, c6, c7, c8 : integer;
  1299.    x : String;
  1300.    g : char;
  1301. Begin
  1302.    For c1 := 0 To 1 Do
  1303.       For c2 := 0 To 1 Do
  1304.          For c3 := 0 To 1 Do
  1305.             For c4 := 0 To 1 Do
  1306.                For c5 := 0 To 1 Do
  1307.                   For c6 := 0 To 1 Do
  1308.                      For c7 := 0 To 1 Do
  1309.                         For c8 := 0 To 1 Do
  1310.                         Begin
  1311.                            x := '';
  1312.                            x := inttostr(c1) + inttostr(c2) + inttostr(c3) + inttostr(c4) + inttostr(c5) + inttostr(c6) + inttostr(c7) + inttostr(c8);
  1313.                            zeronetochar8(g, x);
  1314.                            trans[ord(g)] := x;
  1315.                         End;
  1316. End;
  1320. Procedure initialize6(Var trans : Array Of String);
  1321. Var
  1322.    c1, c2, c3, c4, c5, c6 : integer;
  1323.    x : String;
  1324.    g : integer;
  1325. Begin
  1326.    For c1 := 0 To 1 Do
  1327.       For c2 := 0 To 1 Do
  1328.          For c3 := 0 To 1 Do
  1329.             For c4 := 0 To 1 Do
  1330.                For c5 := 0 To 1 Do
  1331.                   For c6 := 0 To 1 Do
  1332.                   Begin
  1333.                      x := '';
  1334.                      x := inttostr(c1) + inttostr(c2) + inttostr(c3) + inttostr(c4) + inttostr(c5) + inttostr(c6);
  1335.                      zeronetochar6(g, x);
  1336.                      trans[ord(chr64[g])] := x;
  1337.                   End;
  1338. End;
  1341. // Convert 8 bit strings to 6 bit strings and visa versa
  1343. Procedure Convert8to6bit(str8 : String; Var str6 : String);
  1344. Var
  1345.    temp : String;
  1346.    trans : Array[0..255] Of String;
  1347.    i, len6 : longint;
  1348.    g : integer;
  1349. Begin
  1350.    initialize8(trans);
  1351.    temp := '';
  1352.    For i := 1 To length(str8) Do temp := temp + trans[ord(str8[i])];
  1353.    While (length(temp) Mod 6) <> 0 Do temp := temp + '0';
  1354.    len6 := length(temp) Div 6;
  1355.    str6 := '';
  1356.    For i := 1 To len6 Do
  1357.    Begin
  1358.       zeronetochar6(g, copy(temp, 1, 6));
  1359.       str6 := str6 + chr64[g];
  1360.       delete(temp, 1, 6);
  1361.    End;
  1362. End;
  1365. Procedure Convert6to8bit(str6 : String; Var str8 : String);
  1366. Var
  1367.    temp : String;
  1368.    trans : Array[0..255] Of String;
  1369.    i, len8 : longint;
  1370.    g : char;
  1371. Begin
  1372.    initialize6(trans);
  1373.    temp := '';
  1374.    For i := 1 To length(str6) Do temp := temp + trans[ord(str6[i])];
  1375.    str8 := '';
  1376.    len8 := length(temp) Div 8;
  1377.    For i := 1 To len8 Do
  1378.    Begin
  1379.       zeronetochar8(g, copy(temp, 1, 8));
  1380.       str8 := str8 + g;
  1381.       delete(temp, 1, 8);
  1382.    End;
  1383. End;
  1386. // Convert 8 & 6 bit strings to 1 bit strings and visa versa
  1388. Procedure Convert8to1bit(str8 : String; Var str1 : String);
  1389. Var
  1390.    trans : Array[0..255] Of String;
  1391.    i : longint;
  1392. Begin
  1393.    str1 := '';
  1394.    initialize8(trans);
  1395.    For i := 1 To length(str8) Do str1 := str1 + trans[ord(str8[i])];
  1396. End;
  1399. Procedure Convert6to1bit(str6 : String; Var str1 : String);
  1400. Var
  1401.    trans : Array[0..255] Of String;
  1402.    i : longint;
  1403. Begin
  1404.    str1 := '';
  1405.    initialize6(trans);
  1406.    For i := 1 To length(str6) Do str1 := str1 + trans[ord(str6[i])];
  1407. End;
  1410. Procedure Convert1to8bit(str1 : String; Var str8 : String);
  1411. Var
  1412.    i, len8 : longint;
  1413.    g : char;
  1414. Begin
  1415.    str8 := '';
  1416.    While (length(str1) Mod 8) <> 0 Do str1 := '0' + str1;
  1417.    len8 := length(str1) Div 8;
  1418.    For i := 1 To len8 Do
  1419.    Begin
  1420.       zeronetochar8(g, copy(str1, 1, 8));
  1421.       str8 := str8 + g;
  1422.       delete(str1, 1, 8);
  1423.    End;
  1424. End;
  1427. Procedure Convert1to6bit(str1 : String; Var str6 : String);
  1428. Var
  1429.    i, len6 : longint;
  1430.    g : integer;
  1431. Begin
  1432.    str6 := '';
  1433.    While (length(str1) Mod 6) <> 0 Do str1 := '0' + str1;
  1434.    len6 := length(str1) Div 6;
  1435.    For i := 1 To len6 Do
  1436.    Begin
  1437.       zeronetochar6(g, copy(str1, 1, 6));
  1438.       str6 := str6 + chr64[g];
  1439.       delete(str1, 1, 6);
  1440.    End;
  1441. End;
  1444. // convert a base 10 string to a GInt and visa versa
  1446. Procedure DecStrToGInt(GIntstr : String; Var GInt : TGInt);
  1447. Var
  1448.    temp1, temp2 : TGInt;
  1449.    p : Tsign;
  1450. Begin
  1452.    While Not (GIntstr[1] In ['-', '0'..'9']) Do delete(GIntstr, 1, 1);
  1454.    If GIntstr[1] = '-' Then
  1455.    Begin
  1456.       delete(GIntstr, 1, 1);
  1457.       p := negative;
  1458.    End
  1459.    Else p := positive;
  1461.    While (GIntstr[1] = '0') And (length(GIntstr) > 1) Do delete(GIntstr, 1, 1);
  1463.    new(temp2);
  1464.    temp2^.next := Nil;
  1465.    If (length(GIntstr) Mod 4) = 0 Then
  1466.    Begin
  1467.       temp2^.value := strtoint(copy(GIntstr, 1, 4));
  1468.       delete(GIntstr, 1, 4);
  1469.    End
  1470.    Else
  1471.    Begin
  1472.       temp2^.value := strtoint(copy(GIntstr, 1, (length(GIntstr) Mod 4)));
  1473.       delete(GIntstr, 1, (length(GIntstr) Mod 4));
  1474.    End;
  1476.    While length(GIntstr) > 0 Do
  1477.    Begin
  1478.       new(temp1);
  1479.       temp1^.next := temp2;
  1480.       temp2^.prev := temp1;
  1481.       temp1^.value := strtoint(copy(GIntstr, 1, 4));
  1482.       delete(GIntstr, 1, 4);
  1483.       temp2 := temp1;
  1484.    End;
  1486.    temp2^.prev := Nil;
  1487.    temp2^.sign := p;
  1488.    GInt := temp2;
  1490. End;
  1493. Procedure GIntToDecStr(Var GIntstr : String; GInt : TGInt);
  1494. Var
  1495.    s : String;
  1496.    p : TSign;
  1497. Begin
  1498.    GIntstr := '';
  1499.    p := GInt^.sign;
  1501.    s := inttostr(GInt^.value);
  1502.    While length(s) < 4 Do s := '0' + s;
  1503.    GIntstr := s + GIntstr;
  1504.    While GInt^.next <> Nil Do
  1505.    Begin
  1506.       GInt := GInt^.next;
  1507.       s := inttostr(abs(GInt^.value));
  1508.       While length(s) < 4 Do s := '0' + s;
  1509.       GIntstr := s + GIntstr;
  1510.    End;
  1512.    While (GIntstr[1] = '0') And (length(GIntstr) > 1) Do delete(GIntstr, 1, 1);
  1514.    If p = negative Then GIntstr := '-' + GIntstr;
  1516. End;
  1519. // Convert an integer to a GInt
  1521. Procedure IntToGInt(Int : integer; Var GInt : TGInt);
  1522. Begin
  1523.    DecstrtoGInt(inttostr(Int), GInt);
  1524. End;
  1527. // Destroy a GInt, in order to free memory
  1529. Procedure GIntDestroy(Var GInt : TGInt);
  1530. Begin
  1532.    While GInt^.next <> Nil Do GInt := GInt^.next;
  1534.    While GInt^.prev <> Nil Do
  1535.    Begin
  1536.       GInt := GInt^.prev;
  1537.       dispose(GInt^.next);
  1538.    End;
  1539.    dispose(GInt);
  1540. End;
  1543. // Make a copy of a GInt
  1545. Procedure GIntCopy(GInt1 : TGInt; Var GInt2 : TGInt);
  1546. Var
  1547.    temp1, temp2 : TGInt;
  1548. Begin
  1549.    new(GInt2);
  1550.    GInt2^.sign := GInt1^.sign;
  1551.    GInt2^.prev := Nil;
  1552.    GInt2^.value := GInt1^.value;
  1553.    temp1 := GInt2;
  1554.    While GInt1^.next <> Nil Do
  1555.    Begin
  1556.       GInt1 := GInt1^.next;
  1557.       new(temp2);
  1558.       temp2^.value := GInt1^.value;
  1559.       temp2^.prev := temp1;
  1560.       temp1^.next := temp2;
  1561.       temp1 := temp2;
  1562.    End;
  1563.    temp1^.next := Nil;
  1564. End;
  1567. // Divide a GInt by an integer, GInt = res * by + m
  1569. Procedure GIntDivByInt(GInt : TGInt; Var res : TGInt; by : longint; Var m : longint);
  1570. Var
  1571.    S, S1 : String;
  1572. Begin
  1573.    If (by Div 10000) = 0 Then
  1574.    Begin
  1575.       S := '';
  1576.       While GInt^.next <> Nil Do GInt := GInt^.next;
  1577.       S := inttostr(GInt^.value Div by);
  1578.       m := (GInt^.value Mod by);
  1579.       While GInt^.prev <> Nil Do
  1580.       Begin
  1581.          m := m * 10000;
  1582.          GInt := GInt^.prev;
  1583.          S1 := inttostr((GInt^.value + m) Div by);
  1584.          While length(S1) < 4 Do S1 := '0' + S1;
  1585.          S := S + S1;
  1586.          m := ((GInt^.value + m) Mod by);
  1587.       End;
  1588.       decstrtogint(S, res);
  1589.    End;
  1590. End;
  1593. // GInt modulo an integer, GInt mod by = m
  1595. Procedure GIntModByInt(GInt : TGInt; by : longint; Var m : longint);
  1596. Begin
  1597.    If (by Div 10000) = 0 Then
  1598.    Begin
  1599.       While GInt^.next <> Nil Do GInt := GInt^.next;
  1600.       m := (GInt^.value Mod by);
  1601.       While GInt^.prev <> Nil Do
  1602.       Begin
  1603.          m := m * 10000;
  1604.          GInt := GInt^.prev;
  1605.          m := ((GInt^.value + m) Mod by);
  1606.       End;
  1607.    End;
  1608. End;
  1611. // Compare two GInts in absolute value, GInt1 < : St, > : Lt, = : Eq, Error : Er GInt2
  1613. Function GIntCompareAbs(GInt1, GInt2 : TGInt) : TCompare;
  1614. Begin
  1616.    GIntCompareAbs := Er;
  1618.    While (GInt1^.next <> Nil) And (GInt2^.next <> Nil) Do
  1619.    Begin
  1620.       GInt1 := GInt1^.next;
  1621.       GInt2 := GInt2^.next;
  1622.    End;
  1624.    If (GInt1^.next = Nil) And (GInt2^.next <> Nil) Then GIntCompareAbs := St;
  1626.    If (GInt2^.next = Nil) And (GInt1^.next <> Nil) Then GIntCompareAbs := Lt;
  1628.    If (GInt1^.next = Nil) And (GInt2^.next = Nil) Then
  1629.    Begin
  1630.       While (GInt1^.value = GInt2^.value) And (GInt1^.prev <> Nil) Do
  1631.       Begin
  1632.          GInt1 := GInt1^.prev;
  1633.          GInt2 := GInt2^.prev;
  1634.       End;
  1636.       If (GInt1^.value > GInt2^.value) Then GIntCompareAbs := Lt
  1637.       Else If (GInt1^.value < GInt2^.value) Then GIntCompareAbs := St Else GIntCompareAbs := Eq;
  1638.    End
  1640. End;
  1643. // Change the sign of a GInt
  1645. Procedure GIntChangeSign(Var GInt : TGInt);
  1646. Begin
  1647.    If GInt^.sign = negative Then GInt^.sign := positive Else GInt^.sign := negative;
  1648. End;
  1651. // Returns the GInt in its absolute value
  1653. Procedure GIntAbs(Var GInt : TGInt);
  1654. Begin
  1655.    GInt^.sign := positive;
  1656. End;
  1659. // Add 2 GInts, GInt1 + GInt2 = sum
  1661. Procedure GIntAdd(GInt1, GInt2 : TGInt; Var sum : TGInt);
  1662. Var
  1663.    temp1, temp2 : TGInt;
  1664.    rest : integer;
  1665.    Tres : Longint;
  1666. Begin
  1667.    If (GInt1^.sign = GInt2^.sign) Then
  1668.    Begin
  1670.       new(temp2);
  1671.       temp2^.prev := Nil;
  1672.       Tres := GInt1^.value + GInt2^.value;
  1673.       temp2^.value := Tres Mod 10000;
  1674.       temp2^.sign := GInt1^.sign;
  1675.       If Tres >= 10000 Then rest := 1 Else rest := 0;
  1677.       While (GInt1^.next <> Nil) And (GInt2^.next <> Nil) Do
  1678.       Begin
  1679.          GInt1 := GInt1^.next;
  1680.          GInt2 := GInt2^.next;
  1681.          new(temp1);
  1682.          Tres := GInt1^.value + GInt2^.value + rest;
  1683.          temp1^.value := Tres Mod 10000;
  1684.          If Tres >= 10000 Then rest := 1 Else rest := 0;
  1685.          temp1^.prev := temp2;
  1686.          temp2^.next := temp1;
  1687.          temp2 := temp1;
  1688.       End;
  1690.       While (GInt1^.next) <> Nil Do
  1691.       Begin
  1692.          GInt1 := GInt1^.next;
  1693.          new(temp1);
  1694.          Tres := GInt1^.value + rest;
  1695.          temp1^.value := Tres Mod 10000;
  1696.          If Tres >= 10000 Then rest := 1 Else rest := 0;
  1697.          temp1^.prev := temp2;
  1698.          temp2^.next := temp1;
  1699.          temp2 := temp1;
  1700.       End;
  1702.       While (GInt2^.next) <> Nil Do
  1703.       Begin
  1704.          GInt2 := GInt2^.next;
  1705.          new(temp1);
  1706.          Tres := GInt2^.value + rest;
  1707.          temp1^.value := Tres Mod 10000;
  1708.          If Tres >= 10000 Then rest := 1 Else rest := 0;
  1709.          temp1^.prev := temp2;
  1710.          temp2^.next := temp1;
  1711.          temp2 := temp1;
  1712.       End;
  1714.       If rest <> 0 Then
  1715.       Begin
  1716.          new(temp1);
  1717.          temp1^.value := (rest) Mod 10000;
  1718.          temp1^.prev := temp2;
  1719.          temp2^.next := temp1;
  1720.          temp2 := temp1;
  1721.       End;
  1723.       temp2^.next := Nil;
  1724.       sum := temp2;
  1725.       While sum^.prev <> Nil Do sum := sum^.prev;
  1727.    End
  1728.    Else
  1729.    Begin
  1730.       If (GIntCompareAbs(GInt1, GInt2) = Lt) Or (GIntCompareAbs(GInt1, GInt2) = Eq) Then
  1731.       Begin
  1733.          new(temp2);
  1734.          temp2^.prev := Nil;
  1735.          temp2^.sign := GInt1^.sign;
  1736.          Tres := 10000 + GInt1^.value - GInt2^.value;
  1737.          temp2^.value := Tres Mod 10000;
  1738.          If (GInt1^.value - GInt2^.value) < 0 Then rest := -1 Else rest := 0;
  1740.          While (GInt1^.next <> Nil) And (GInt2^.next <> Nil) Do
  1741.          Begin
  1742.             GInt1 := GInt1^.next;
  1743.             GInt2 := GInt2^.next;
  1744.             new(temp1);
  1745.             Tres := GInt1^.value - GInt2^.value + rest;
  1746.             temp1^.value := (10000 + Tres) Mod 10000;
  1747.             If Tres < 0 Then rest := -1 Else rest := 0;
  1748.             temp1^.prev := temp2;
  1749.             temp2^.next := temp1;
  1750.             temp2 := temp1;
  1751.          End;
  1753.          While (GInt1^.next) <> Nil Do
  1754.          Begin
  1755.             GInt1 := GInt1^.next;
  1756.             new(temp1);
  1757.             Tres := GInt1^.value + rest;
  1758.             temp1^.value := (10000 + Tres) Mod 10000;
  1759.             If Tres < 0 Then rest := -1 Else rest := 0;
  1760.             temp1^.prev := temp2;
  1761.             temp2^.next := temp1;
  1762.             temp2 := temp1;
  1763.          End;
  1766.          If rest <> 0 Then
  1767.          Begin
  1768.             new(temp1);
  1769.             temp1^.value := (10000 + rest) Mod 10000;
  1770.             temp1^.prev := temp2;
  1771.             temp2^.next := temp1;
  1772.             temp2 := temp1;
  1773.          End;
  1775.          While (temp2^.value = 0) And (temp2^.prev <> Nil) Do
  1776.          Begin
  1777.             temp2 := temp2^.prev;
  1778.             dispose(temp2^.next);
  1779.             temp2^.next := Nil;
  1780.          End;
  1781.          temp2^.next := Nil;
  1782.          sum := temp2;
  1783.          While sum^.prev <> Nil Do sum := sum^.prev;
  1785.       End
  1787.       Else
  1788.          GIntadd(GInt2, GInt1, sum);
  1790.    End
  1792. End;
  1795. // Subtract 2 GInts, GInt1 - GInt2 = dif
  1797. Procedure GIntSub(GInt1, GInt2 : TGInt; Var dif : TGInt);
  1798. Begin
  1799.    GIntchangesign(GInt2);
  1800.    GIntadd(GInt1, GInt2, dif);
  1801.    GIntchangesign(GInt2);
  1802. End;
  1805. // Multiply 2 GInts, GInt1 * GInt2 = prod
  1807. Procedure GIntMul(GInt1, GInt2 : TGInt; Var prod : TGInt);
  1808. Var
  1809.    zero, temp1, temp2, temp : TGInt;
  1810.    sign : Tsign;
  1811.    rest, Trest : longint;
  1812. Begin
  1813.    decstrtogint('0', zero);
  1814.    If Not ((GIntcompareabs(zero, GInt1) = Eq) Or (GIntcompareabs(zero, GInt2) = Eq)) Then
  1815.    Begin
  1816.       If GInt1^.sign = GInt2^.sign Then sign := positive Else sign := negative;
  1817.       temp1 := GInt1;
  1819.       new(temp2);
  1820.       temp2^.sign := sign;
  1821.       temp2^.prev := Nil;
  1822.       temp2^.value := (GInt2^.value * temp1^.value) Mod 10000;
  1823.       rest := (GInt2^.value * temp1^.value) Div 10000;
  1824.       temp2^.next := Nil;
  1825.       prod := temp2;
  1826.       While temp1^.next <> Nil Do
  1827.       Begin
  1828.          temp1 := temp1^.next;
  1829.          new(temp);
  1830.          temp^.value := (GInt2^.value * temp1^.value + rest) Mod 10000;
  1831.          rest := (GInt2^.value * temp1^.value + rest) Div 10000;
  1832.          temp^.next := Nil;
  1833.          temp2^.next := temp;
  1834.          temp^.prev := temp2;
  1835.          temp2 := temp2^.next;
  1836.       End;
  1837.       If rest <> 0 Then
  1838.       Begin
  1839.          new(temp);
  1840.          temp^.value := rest;
  1841.          temp^.next := Nil;
  1842.          temp^.prev := temp2;
  1843.          temp2^.next := temp;
  1844.       End;
  1846.       While GInt2^.next <> Nil Do
  1847.       Begin
  1848.          If prod^.next = Nil Then
  1849.          Begin
  1850.             new(temp2);
  1851.             temp2^.value := 0;
  1852.             temp2^.prev := prod;
  1853.             prod^.next := temp2;
  1854.             temp2^.next := Nil;
  1855.          End;
  1856.          prod := prod^.next;
  1857.          GInt2 := GInt2^.next;
  1858.          temp1 := GInt1;
  1859.          temp2 := prod;
  1860.          rest := (GInt2^.value * temp1^.value + temp2^.value) Div 10000;
  1861.          temp2^.value := (GInt2^.value * temp1^.value + temp2^.value) Mod 10000;
  1863.          While temp1^.next <> Nil Do
  1864.          Begin
  1865.             temp1 := temp1^.next;
  1866.             If temp2^.next = Nil Then
  1867.             Begin
  1868.                new(temp);
  1869.                temp^.value := 0;
  1870.                temp^.next := Nil;
  1871.             End
  1872.             Else temp := temp2^.next;
  1873.             trest := (GInt2^.value * temp1^.value + rest + temp^.value) Div 10000;
  1874.             temp^.value := (GInt2^.value * temp1^.value + rest + temp^.value) Mod 10000;
  1875.             rest := trest;
  1876.             temp2^.next := temp;
  1877.             temp^.prev := temp2;
  1878.             temp2 := temp2^.next;
  1879.          End;
  1880.          If rest <> 0 Then
  1881.          Begin
  1882.             If temp2^.next = Nil Then
  1883.             Begin
  1884.                new(temp);
  1885.                temp^.value := 0;
  1886.                temp^.next := Nil;
  1887.             End
  1888.             Else temp := temp2^.next;
  1889.             temp^.value := temp^.value + rest;
  1890.             temp^.next := Nil;
  1891.             temp^.prev := temp2;
  1892.             temp2^.next := temp;
  1893.          End;
  1895.       End;
  1897.       While prod^.prev <> Nil Do prod := prod^.prev;
  1898.    End
  1899.    Else decstrtogint('0', prod);
  1900.    GIntdestroy(zero);
  1902. End;
  1905. // Prod = GInt1 * By, By < 10000
  1907. Procedure GIntMulByInt(GInt1 : TGInt; By : Longint; Var prod : TGInt);
  1908. Var
  1909.    temp2, temp : TGInt;
  1910.    sign : Tsign;
  1911.    rest : longint;
  1912. Begin
  1913.    If By < 0 Then sign := negative Else sign := positive;
  1914.    If GInt1^.sign = sign Then sign := positive Else sign := negative;
  1915.    by := abs(by);
  1917.    new(temp2);
  1918.    temp2^.sign := sign;
  1919.    temp2^.prev := Nil;
  1920.    temp2^.value := (GInt1^.value * by) Mod 10000;
  1921.    rest := (GInt1^.value * by) Div 10000;
  1922.    temp2^.next := Nil;
  1923.    prod := temp2;
  1925.    While GInt1^.next <> Nil Do
  1926.    Begin
  1927.       GInt1 := GInt1^.next;
  1928.       new(temp);
  1929.       temp^.value := (GInt1^.value * By + rest) Mod 10000;
  1930.       rest := (GInt1^.value * By + rest) Div 10000;
  1931.       temp^.next := Nil;
  1932.       temp2^.next := temp;
  1933.       temp^.prev := temp2;
  1934.       temp2 := temp2^.next;
  1935.    End;
  1937.    If rest <> 0 Then
  1938.    Begin
  1939.       new(temp);
  1940.       temp^.value := rest;
  1941.       temp^.next := Nil;
  1942.       temp^.prev := temp2;
  1943.       temp2^.next := temp;
  1944.    End;
  1947.    While prod^.prev <> Nil Do prod := prod^.prev;
  1949. End;
  1952. // GInt = GInt * By, By < 10000
  1954. Procedure GIntMulByIntBis(Var GInt : TGInt; By : Longint);
  1955. Var
  1956.    temp1, temp : TGInt;
  1957.    sign : Tsign;
  1958.    rest, TRest : longint;
  1959. Begin
  1960.    If By < 0 Then sign := negative Else sign := positive;
  1961.    If GInt^.sign = sign Then sign := positive Else sign := negative;
  1962.    by := abs(by);
  1964.    GInt^.sign := sign;
  1965.    Trest := GInt^.value * By;
  1966.    GInt^.value := Trest Mod 10000;
  1967.    rest := Trest Div 10000;
  1968.    temp1 := GInt;
  1970.    While GInt^.next <> Nil Do
  1971.    Begin
  1972.       GInt := GInt^.next;
  1973.       Trest := GInt^.value * By + rest;
  1974.       GInt^.value := Trest Mod 10000;
  1975.       rest := Trest Div 10000;
  1976.    End;
  1978.    If rest <> 0 Then
  1979.    Begin
  1980.       new(temp);
  1981.       temp^.value := rest;
  1982.       temp^.next := Nil;
  1983.       temp^.prev := GInt;
  1984.       GInt^.next := temp;
  1985.    End;
  1986.    GInt := temp1;
  1987. End;
  1990. // Square a GInt, GInt^2 = Square
  1992. Procedure GIntSquare(GInt : TGInt; Var Square : TGInt);
  1993. Begin
  1994.    GIntMul(GInt, GInt, square);
  1995. End;
  1998. // Convert a GInt to a binary string (base 2) & visa versa
  2000. Procedure GIntToBinStr(GInt : TGint; Var S : String);
  2001. Var
  2002.    zero, temp, temp1 : TGInt;
  2003.    i : integer;
  2004. Begin
  2005.    DecStrToGInt('0', zero);
  2006.    GIntCopy(GInt, temp);
  2007.    S := '';
  2008.    While GIntCompareAbs(zero, temp) <> Eq Do
  2009.    Begin
  2010.       GIntDivByInt(temp, temp1, 2, i);
  2011.       S := inttostr(i) + S;
  2012.       GIntDestroy(temp);
  2013.       temp := temp1;
  2014.    End;
  2015.    If S = '' Then S := '0';
  2016.    GIntDestroy(temp);
  2017.    GIntDestroy(zero);
  2018. End;
  2021. Procedure BinStrToGInt(S : String; Var GInt : TGInt);
  2022. Var
  2023.    temp, temp2 : TGInt;
  2024.    i : longint;
  2025. Begin
  2026.    While copy(S, 1, 1) = '0' Do delete(S, 1, 1);
  2027.    decstrtogint('0', GInt);
  2028.    decstrtogint('1', temp);
  2029.    For i := length(S) Downto 1 Do
  2030.    Begin
  2031.       If S[i] = '1' Then
  2032.       Begin
  2033.          GIntadd(GInt, temp, temp2);
  2034.          GIntdestroy(GInt);
  2035.          GInt := temp2;
  2036.       End;
  2037.       GIntmulByIntBis(temp, 2);
  2038.    End;
  2039.    GIntdestroy(temp);
  2040. End;
  2043. // Convert a GInt to an 8 bit string & visa versa
  2045. Procedure GIntToStr(GInt : TGInt; Var str : String);
  2046. Var
  2047.    temp1 : String;
  2048.    i, len8 : longint;
  2049.    g : char;
  2050. Begin
  2051.    GInttobinstr(GInt, temp1);
  2052.    While (length(temp1) Mod 8) <> 0 Do temp1 := '0' + temp1;
  2053.    len8 := length(temp1) Div 8;
  2054.    str := '';
  2055.    For i := 1 To len8 Do
  2056.    Begin
  2057.       zeronetochar8(g, copy(temp1, 1, 8));
  2058.       str := str + g;
  2059.       delete(temp1, 1, 8);
  2060.    End;
  2061. End;
  2064. Procedure StrToGInt(str : String; Var GInt : TGInt);
  2065. Var
  2066.    temp1 : String;
  2067.    i : longint;
  2068.    trans : Array[0..255] Of String;
  2069. Begin
  2070.    temp1 := '';
  2071.    initialize8(trans);
  2072.    For i := 1 To length(str) Do temp1 := temp1 + trans[ord(str[i])];
  2073.    While temp1[1] = '0' Do delete(temp1, 1, 1);
  2074.    binstrtoGInt(temp1, GInt);
  2075. End;
  2078. // Exponentiate a GInt, GInt^exp = res
  2080. Procedure GIntExp(GInt, exp : TGInt; Var res : TGInt);
  2081. Var
  2082.    temp2, temp3 : TGInt;
  2083.    S : String;
  2084.    i : longint;
  2085. Begin
  2086.    GInttobinstr(exp, S);
  2087.    If S[length(S)] = '0' Then decstrtogint('1', res) Else GIntcopy(GInt, res);
  2088.    GIntcopy(GInt, temp2);
  2089.    If length(S) > 1 Then
  2090.       For i := (length(S) - 1) Downto 1 Do
  2091.       Begin
  2092.          GIntSquare(temp2, temp3);
  2093.          GIntdestroy(temp2);
  2094.          temp2 := temp3;
  2095.          If S[i] = '1' Then
  2096.          Begin
  2097.             GIntmul(res, temp2, temp3);
  2098.             GIntdestroy(res);
  2099.             res := temp3;
  2100.          End;
  2101.       End;
  2102. End;
  2105. // Compute GInt! = GInt * (GInt - 1) * (GInt - 2) * ... * 3 * 2 * 1
  2107. Procedure GIntFac(GInt : TGInt; Var res : TGint);
  2108. Var
  2109.    one, temp, temp1 : TGInt;
  2110. Begin
  2111.    GIntcopy(GInt, temp);
  2112.    decstrtogint('1', res);
  2113.    decstrtogint('1', one);
  2115.    While Not ((temp^.next = Nil) And (temp^.value = 1)) Do
  2116.    Begin
  2117.       GIntmul(temp, res, temp1);
  2118.       GIntdestroy(res);
  2119.       res := temp1;
  2120.       GIntsub(temp, one, temp1);
  2121.       GIntdestroy(temp);
  2122.       temp := temp1;
  2123.    End;
  2125.    GIntdestroy(one);
  2126.    GIntdestroy(temp);
  2128. End;
  2131. // Divide 2 GInts, GInt1 = GInt2 * divres + modres, modres is always positive
  2133. Procedure GIntDivMod(GInt1, GInt2 : TGInt; Var divres, modres : TGInt);
  2134. Var
  2135.    s1, s2 : TSign;
  2136.    Tempstr1, tempstr2, tempstr, QStr : String;
  2137.    lend, k, i : longint;
  2138.    temp1, temp2, one, zero, temp : TGInt;
  2139.    QCnt : integer;
  2140. Begin
  2141.    s1 := GInt1^.sign;
  2142.    s2 := GInt2^.sign;
  2143.    GIntabs(GInt1);
  2144.    GIntabs(GInt2);
  2145.    GInttodecstr(tempstr1, GInt1);
  2146.    GInttodecstr(tempstr2, GInt2);
  2147.    lend := length(tempstr2);
  2148.    QStr := '0';
  2149.    decstrtogint('0', zero);
  2152.    If Not ((GInt1^.value = 0) And (GInt1^.next = Nil)) Then
  2153.    Begin
  2155.       GIntcopy(GInt1, temp);
  2156.       tempstr := tempstr1;
  2157.       k := lend;
  2158.       While (GIntcompareabs(temp, GInt2) <> St) Do
  2159.       Begin
  2160.          GIntDestroy(temp);
  2161.          tempstr := copy(tempstr1, 1, k);
  2162.          delete(tempstr1, 1, k);
  2164.          While (length(tempstr) < lend) And (length(tempstr1) > 0) Do
  2165.          Begin
  2166.             tempstr := tempstr + copy(tempstr1, 1, 1);
  2167.             delete(tempstr1, 1, 1);
  2168.             QStr := QStr + '0';
  2169.          End;
  2171.          decstrtoGInt(tempstr, temp1);
  2172.          QCnt := 0;
  2173.          While GIntcompareabs(temp1, GInt2) <> St Do
  2174.          Begin
  2175.             GIntSub(temp1, GInt2, temp2);
  2176.             GIntdestroy(temp1);
  2177.             temp1 := temp2;
  2178.             QCnt := QCnt + 1;
  2179.          End;
  2180.          QStr := QStr + inttostr(QCnt);
  2181.          GInttodecstr(tempstr, temp1);
  2183.          k := length(tempstr) + 1;
  2184.          tempstr1 := tempstr + tempstr1;
  2185.          GIntdestroy(temp1);
  2187.          DecStrToGInt(tempstr1, temp);
  2188.       End;
  2189.       If (GIntcompareabs(temp, GInt2) = St) And ((k - 1) <> length(tempstr1)) Then
  2190.          For i := 1 To (length(tempstr1) - k + 1) Do QStr := QStr + '0';
  2191.       GIntDestroy(temp);
  2193.       DecstrtoGInt(tempstr1, modres);
  2194.       DecstrtoGInt(QStr, divres);
  2196.       decstrtogint('1', one);
  2197.       If s1 = negative Then
  2198.       Begin
  2199.          If GIntcompareabs(modres, zero) <> Eq Then
  2200.          Begin
  2201.             GIntadd(divres, one, temp1);
  2202.             GIntdestroy(divres);
  2203.             divres := temp1;
  2204.             GIntAbs(GInt2);
  2205.             GIntsub(GInt2, modres, temp1);
  2206.             GIntdestroy(modres);
  2207.             GInt2^.sign := s2;
  2208.             modres := temp1;
  2209.          End;
  2210.          If s2 = positive Then divres^.sign := negative;
  2211.       End
  2212.       Else divres^.sign := s2;
  2214.       GIntdestroy(one);
  2215.    End
  2216.    Else
  2217.    Begin
  2218.       GIntcopy(zero, divres);
  2219.       GIntcopy(zero, modres);
  2220.    End;
  2221.    GIntdestroy(zero);
  2223.    GInt1^.sign := s1;
  2224.    GInt2^.sign := s2;
  2225. End;
  2229. // Same as above but doesn't compute modres
  2231. Procedure GIntDiv(GInt1, GInt2 : TGInt; Var divres : TGInt);
  2232. Var
  2233.    s1, s2 : TSign;
  2234.    Tempstr1, tempstr2, tempstr, QStr : String;
  2235.    lend, k, i : longint;
  2236.    temp1, temp2, one, zero, temp, modres : TGInt;
  2237.    QCnt : integer;
  2238. Begin
  2239.    s1 := GInt1^.sign;
  2240.    s2 := GInt2^.sign;
  2241.    GIntabs(GInt1);
  2242.    GIntabs(GInt2);
  2243.    GInttodecstr(tempstr1, GInt1);
  2244.    GInttodecstr(tempstr2, GInt2);
  2245.    lend := length(tempstr2);
  2246.    QStr := '0';
  2247.    decstrtogint('0', zero);
  2250.    If Not ((GInt1^.value = 0) And (GInt1^.next = Nil)) Then
  2251.    Begin
  2253.       GIntcopy(GInt1, temp);
  2254.       tempstr := tempstr1;
  2255.       k := lend;
  2256.       While (GIntcompareabs(temp, GInt2) <> St) Do
  2257.       Begin
  2258.          GIntDestroy(temp);
  2259.          tempstr := copy(tempstr1, 1, k);
  2260.          delete(tempstr1, 1, k);
  2262.          While (length(tempstr) < lend) And (length(tempstr1) > 0) Do
  2263.          Begin
  2264.             tempstr := tempstr + copy(tempstr1, 1, 1);
  2265.             delete(tempstr1, 1, 1);
  2266.             QStr := QStr + '0';
  2267.          End;
  2269.          decstrtoGInt(tempstr, temp1);
  2270.          QCnt := 0;
  2271.          While GIntcompareabs(temp1, GInt2) <> St Do
  2272.          Begin
  2273.             GIntSub(temp1, GInt2, temp2);
  2274.             GIntdestroy(temp1);
  2275.             temp1 := temp2;
  2276.             QCnt := QCnt + 1;
  2277.          End;
  2278.          QStr := QStr + inttostr(QCnt);
  2279.          GInttodecstr(tempstr, temp1);
  2281.          k := length(tempstr) + 1;
  2282.          tempstr1 := tempstr + tempstr1;
  2283.          GIntdestroy(temp1);
  2285.          DecStrToGInt(tempstr1, temp);
  2286.       End;
  2287.       If (GIntcompareabs(temp, GInt2) = St) And ((k - 1) <> length(tempstr1)) Then
  2288.          For i := 1 To (length(tempstr1) - k + 1) Do QStr := QStr + '0';
  2289.       GIntDestroy(temp);
  2291.       DecstrtoGInt(tempstr1, modres);
  2292.       DecstrtoGInt(QStr, divres);
  2294.       decstrtogint('1', one);
  2295.       If s1 = negative Then
  2296.       Begin
  2297.          If GIntcompareabs(modres, zero) <> Eq Then
  2298.          Begin
  2299.             GIntadd(divres, one, temp1);
  2300.             GIntdestroy(divres);
  2301.             divres := temp1;
  2302.             GIntAbs(GInt2);
  2303.             GIntsub(GInt2, modres, temp1);
  2304.             GIntdestroy(modres);
  2305.             GInt2^.sign := s2;
  2306.             modres := temp1;
  2307.          End;
  2308.          If s2 = positive Then divres^.sign := negative;
  2309.       End
  2310.       Else divres^.sign := s2;
  2312.       GIntdestroy(one);
  2313.    End
  2314.    Else
  2315.    Begin
  2316.       GIntcopy(zero, divres);
  2317.       GIntcopy(zero, modres);
  2318.    End;
  2319.    GIntdestroy(zero);
  2321.    GInt1^.sign := s1;
  2322.    GInt2^.sign := s2;
  2323.    GIntDestroy(modres);
  2324. End;
  2327. // Same as above but computes modres and not divres
  2329. Procedure GIntMod(GInt1, GInt2 : TGInt; Var modres : TGInt);
  2330. Var
  2331.    s1, s2 : TSign;
  2332.    Tempstr1, tempstr2, tempstr, QStr : String;
  2333.    lend, k : longint;
  2334.    temp1, temp2, zero, temp : TGInt;
  2335. Begin
  2336.    s1 := GInt1^.sign;
  2337.    s2 := GInt2^.sign;
  2338.    GIntabs(GInt1);
  2339.    GIntabs(GInt2);
  2340.    GInttodecstr(tempstr1, GInt1);
  2341.    GInttodecstr(tempstr2, GInt2);
  2342.    lend := length(tempstr2);
  2343.    QStr := '0';
  2344.    decstrtogint('0', zero);
  2347.    If Not ((GInt1^.value = 0) And (GInt1^.next = Nil)) Then
  2348.    Begin
  2350.       GIntcopy(GInt1, temp);
  2351.       tempstr := tempstr1;
  2352.       k := lend;
  2353.       While (GIntcompareabs(temp, GInt2) <> St) Do
  2354.       Begin
  2355.          GIntDestroy(temp);
  2356.          tempstr := copy(tempstr1, 1, k);
  2357.          delete(tempstr1, 1, k);
  2359.          While (length(tempstr) < lend) And (length(tempstr1) > 0) Do
  2360.          Begin
  2361.             tempstr := tempstr + copy(tempstr1, 1, 1);
  2362.             delete(tempstr1, 1, 1);
  2363.          End;
  2365.          decstrtoGInt(tempstr, temp1);
  2366.          While GIntcompareabs(temp1, GInt2) <> St Do
  2367.          Begin
  2368.             GIntSub(temp1, GInt2, temp2);
  2369.             GIntdestroy(temp1);
  2370.             temp1 := temp2;
  2371.          End;
  2372.          GInttodecstr(tempstr, temp1);
  2374.          k := length(tempstr) + 1;
  2375.          tempstr1 := tempstr + tempstr1;
  2376.          GIntdestroy(temp1);
  2378.          DecStrToGInt(tempstr1, temp);
  2379.       End;
  2380.       GIntDestroy(temp);
  2382.       DecstrtoGInt(tempstr1, modres);
  2384.       If s1 = negative Then
  2385.       Begin
  2386.          If GIntcompareabs(modres, zero) <> Eq Then
  2387.          Begin
  2388.             GIntAbs(GInt2);
  2389.             GIntsub(GInt2, modres, temp1);
  2390.             GIntdestroy(modres);
  2391.             GInt2^.sign := s2;
  2392.             modres := temp1;
  2393.          End;
  2394.       End;
  2396.    End
  2397.    Else
  2398.    Begin
  2399.       GIntcopy(zero, modres);
  2400.    End;
  2401.    GIntdestroy(zero);
  2403.    GInt1^.sign := s1;
  2404.    GInt2^.sign := s2;
  2405. End;
  2409. // Square a GInt modulo Modb, GInt^2 mod Modb = GIntSM
  2411. Procedure GIntSquareMod(GInt, Modb : TGInt; Var GIntSM : TGInt);
  2412. Var
  2413.    temp : TGInt;
  2414. Begin
  2415.    GIntSquare(GInt, temp);
  2416.    GIntMod(temp, Modb, GIntSM);
  2417.    GIntDestroy(temp);
  2418. End;
  2421. // Add 2 GInts modulo base, (GInt1 + GInt2) mod base = GIntres
  2423. Procedure GIntAddMod(GInt1, GInt2, base : TGInt; Var GIntres : TGInt);
  2424. Var
  2425.    temp : TGInt;
  2426. Begin
  2427.    GIntadd(GInt1, GInt2, temp);
  2428.    GIntMod(temp, base, GIntres);
  2429.    GIntdestroy(temp);
  2430. End;
  2433. // Multiply 2 GInts modulo base, (GInt1 * GInt2) mod base = GIntres
  2435. Procedure GIntMulMod(GInt1, GInt2, base : TGInt; Var GIntres : TGInt);
  2436. Var
  2437.    temp : TGInt;
  2438. Begin
  2439.    GIntMul(GInt1, GInt2, temp);
  2440.    GIntMod(temp, base, GIntres);
  2441.    GIntdestroy(temp);
  2442. End;
  2445. // Exponentiate 2 GInts modulo base, (GInt1 ^ GInt2) mod modb = res
  2447. Procedure GIntModExp(GInt, exp, modb : TGInt; Var res : TGInt);
  2448. Var
  2449.    temp2, temp3 : TGInt;
  2450.    S : String;
  2451.    i : longint;
  2452. Begin
  2453.    GInttobinstr(exp, S);
  2454.    If S[length(S)] = '0' Then decstrtogint('1', res) Else GIntcopy(GInt, res);
  2455.    GIntcopy(GInt, temp2);
  2456.    If length(S) > 1 Then
  2457.       For i := (length(S) - 1) Downto 1 Do
  2458.       Begin
  2459.          GIntSquareMod(temp2, Modb, temp3);
  2460.          GIntdestroy(temp2);
  2461.          temp2 := temp3;
  2462.          If S[i] = '1' Then
  2463.          Begin
  2464.             GIntmulMod(res, temp2, modb, temp3);
  2465.             GIntdestroy(res);
  2466.             res := temp3;
  2467.          End;
  2468.       End;
  2469. End;
  2472. // Compute the Greatest Common Divisor of 2 GInts
  2474. Procedure GIntGCD(GInt1, GInt2 : TGint; Var GCD : TGInt);
  2475. Var
  2476.    k : TCompare;
  2477.    zero, temp1, temp2, temp3 : TGInt;
  2478. Begin
  2479.    k := GIntcompareabs(GInt1, GInt2);
  2480.    If (k = Eq) Then GIntCopy(GInt1, GCD) Else
  2481.       If (k = St) Then GIntGCD(GInt2, GInt1, GCD) Else
  2482.       Begin
  2483.          decstrtogint('0', zero);
  2484.          GIntCopy(GInt1, temp1);
  2485.          GIntCopy(GInt2, temp2);
  2486.          While GIntcompareabs(temp2, zero) <> Eq Do
  2487.          Begin
  2488.             GIntmod(temp1, temp2, temp3);
  2489.             GIntdestroy(temp1);
  2490.             temp1 := temp2;
  2491.             temp2 := temp3;
  2492.          End;
  2493.          GCD := temp1;
  2494.          GIntdestroy(temp2);
  2495.          GIntdestroy(zero);
  2496.       End;
  2497. End;
  2500. // Compute the Least Common Multiple of 2 GInts
  2502. Procedure GIntLCM(GInt1, GInt2 : TGInt; Var LCM : TGInt);
  2503. Var
  2504.    temp1, temp2 : TGInt;
  2505. Begin
  2506.    GIntGCD(GInt1, GInt2, temp1);
  2507.    GIntmul(GInt1, GInt2, temp2);
  2508.    GIntdiv(temp2, temp1, LCM);
  2509.    GIntDestroy(temp1);
  2510.    GIntDestroy(temp2);
  2511. End;
  2514. // Trialdivision of a GInt upto 8192 and stopping when a divisor is found, returning ok=false
  2516. Procedure GIntTrialDiv9999(GInt : TGInt; Var ok : boolean);
  2517. Var
  2518.    i, j : integer;
  2519. Begin
  2520.    If ((GInt^.value Mod 2) = 0) Or ((GInt^.value Mod 5) = 0) Then ok := false
  2521.    Else
  2522.    Begin
  2523.       i := 0;
  2524.       ok := true;
  2525.       While ok And (i < 1227) Do
  2526.       Begin
  2527.          i := i + 1;
  2528.          GIntmodbyint(GInt, primes[i], j);
  2529.          If j = 0 Then ok := false;
  2530.       End;
  2531.    End;
  2532. End;
  2535. // A prng
  2537. Procedure GIntRandom1(Seed : TGInt; Var RandomGInt : TGInt);
  2538. Var
  2539.    temp, base : TGInt;
  2540. Begin
  2541.    decstrtoGInt('281474976710656', base);
  2542.    decstrtoGInt('44485709377909', temp);
  2543.    GIntMulMod(seed, temp, base, RandomGInt);
  2544.    GIntdestroy(temp);
  2545.    GIntdestroy(base);
  2546. End;
  2549. // Perform a Rabin Miller Primality Test nrtest times on GIntp, returns ok=true when GIntp passes the test
  2551. Procedure GIntRabinMiller(GIntp : TGInt; nrtest : integer; Var ok : boolean);
  2552. Var
  2553.    j, b, i : longint;
  2554.    m, z, temp1, temp2, temp3, zero, one, two, pmin1 : TGInt;
  2555.    ok1, ok2 : boolean;
  2556. Begin
  2557.    randomize;
  2558.    j := 0;
  2559.    b := 0;
  2560.    decstrtogint('0', zero);
  2561.    decstrtogint('1', one);
  2562.    decstrtogint('2', two);
  2563.    GIntsub(GIntp, one, temp1);
  2564.    GIntsub(GIntp, one, pmin1);
  2566.    While (temp1^.value Mod 2) = 0 Do
  2567.    Begin
  2568.       b := b + 1;
  2569.       GIntdivbyint(temp1, temp2, 2, i);
  2570.       GIntdestroy(temp1);
  2571.       temp1 := temp2;
  2572.    End;
  2573.    m := temp1;
  2575.    i := 0;
  2576.    ok := true;
  2577.    Randomize;
  2578.    While (i < nrtest) And ok Do
  2579.    Begin
  2580.       i := i + 1;
  2581.       DecStrToGInt(inttostr(Primes[Random(1227) + 1]), temp2);
  2582.       GIntmodexp(temp2, m, GIntp, z);
  2583.       GIntdestroy(temp2);
  2584.       ok1 := (GIntcompareabs(z, one) = Eq);
  2585.       ok2 := (GIntcompareabs(z, pmin1) = Eq);
  2586.       If Not (ok1 Or ok2) Then
  2587.       Begin
  2589.          While (ok And (j < b)) Do
  2590.          Begin
  2591.             If (j > 0) And ok1 Then ok := false
  2592.             Else
  2593.             Begin
  2594.                j := j + 1;
  2595.                If (j < b) And (Not ok2) Then
  2596.                Begin
  2597.                   GIntSquaremod(z, GIntp, temp3);
  2598.                   GIntdestroy(z);
  2599.                   z := temp3;
  2600.                   ok1 := (GIntcompareabs(z, one) = Eq);
  2601.                   ok2 := (GIntcompareabs(z, pmin1) = Eq);
  2602.                   If ok2 Then j := b;
  2603.                End
  2604.                Else If (Not ok2) And (j >= b) Then ok := false;
  2605.             End;
  2606.          End;
  2608.       End
  2609.    End;
  2611.    GIntdestroy(zero);
  2612.    GIntdestroy(one);
  2613.    GIntdestroy(two);
  2614.    GIntdestroy(m);
  2615.    GIntdestroy(z);
  2616.    GIntdestroy(pmin1);
  2618. End;
  2621. // Compute the coefficients from the Bezout Bachet theorem, GInt1 * a + GInt2 * b = GCD(GInt1, GInt2)
  2623. Procedure GIntBezoutBachet(GInt1, GInt2 : TGInt; Var a, b : TGInt);
  2624. Var
  2625.    zero, r1, r2, r3, ta, gcd, temp, temp1, temp2 : TGInt;
  2626. Begin
  2627.    If GIntcompareabs(GInt1, GInt2) <> St Then
  2628.    Begin
  2629.       GIntcopy(GInt1, r1);
  2630.       GIntcopy(GInt2, r2);
  2631.       decstrtogint('0', zero);
  2632.       decstrtogint('1', a);
  2633.       decstrtogint('0', ta);
  2635.       Repeat
  2636.          GIntdivmod(r1, r2, temp, r3);
  2637.          GIntdestroy(r1);
  2638.          r1 := r2;
  2639.          r2 := r3;
  2641.          GIntmul(ta, temp, temp1);
  2642.          GIntsub(a, temp1, temp2);
  2643.          GIntdestroy(a);
  2644.          GIntdestroy(temp1);
  2645.          a := ta;
  2646.          ta := temp2;
  2648.          GIntdestroy(temp);
  2649.       Until GIntcompareabs(r3, zero) = Eq;
  2651.       GIntGCD(GInt1, GInt2, gcd);
  2652.       GIntmul(a, GInt1, temp1);
  2653.       GIntsub(gcd, temp1, temp2);
  2654.       GIntDestroy(temp1);
  2655.       GIntdiv(temp2, GInt2, b);
  2656.       GIntDestroy(temp2);
  2658.       GIntdestroy(ta);
  2659.       GIntdestroy(r1);
  2660.       GIntdestroy(r2);
  2661.       GIntdestroy(gcd);
  2662.    End
  2663.    Else GIntBezoutBachet(GInt2, GInt1, b, a);
  2664. End;
  2667. // Find the (multiplicative) Modular inverse of a GInt in a finite ring of additive order base
  2669. Procedure GIntModInv(GInt1, base : TGInt; Var Inverse : TGInt);
  2670. Var
  2671.    zero, one, r1, r2, r3, tb, gcd, temp, temp1, temp2 : TGInt;
  2672. Begin
  2673.    decstrtogint('1', one);
  2674.    GIntGCD(GInt1, base, gcd);
  2675.    If GIntcompareabs(one, gcd) = Eq Then
  2676.    Begin
  2677.       GIntcopy(base, r1);
  2678.       GIntcopy(GInt1, r2);
  2679.       decstrtogint('0', zero);
  2680.       decstrtogint('0', inverse);
  2681.       decstrtogint('1', tb);
  2683.       Repeat
  2684.          GIntdivmod(r1, r2, temp, r3);
  2685.          GIntdestroy(r1);
  2686.          r1 := r2;
  2687.          r2 := r3;
  2689.          GIntmul(tb, temp, temp1);
  2690.          GIntsub(inverse, temp1, temp2);
  2691.          GIntdestroy(inverse);
  2692.          GIntdestroy(temp1);
  2693.          inverse := tb;
  2694.          tb := temp2;
  2696.          GIntdestroy(temp);
  2697.       Until GIntcompareabs(r3, zero) = Eq;
  2699.       If inverse^.sign = negative Then
  2700.       Begin
  2701.          GIntadd(base, inverse, temp);
  2702.          GIntdestroy(inverse);
  2703.          inverse := temp;
  2704.       End;
  2706.       GIntdestroy(tb);
  2707.       GIntdestroy(r1);
  2708.       GIntdestroy(r2);
  2709.    End;
  2710.    GIntdestroy(gcd);
  2711.    GIntdestroy(one);
  2712. End;
  2715. // Perform a (combined) primality test on GIntp consisting of a trialdivision upto 8192,
  2716. // if the GInt passes perform nrRMtests Rabin Miller primality tests, returns ok when a
  2717. // GInt is probably prime
  2719. Procedure GIntPrimetest(GIntp : TGInt; nrRMtests : integer; Var ok : boolean);
  2720. Begin
  2721.    GIntTrialdiv9999(GIntp, ok);
  2722.    If ok Then GIntRabinMiller(GIntp, nrRMtests, ok);
  2723. End;
  2725. // Computes the Legendre symbol for a any number and
  2726. // p a prime, returns 0 if p divides a, 1 if a is a
  2727. // quadratic residu mod p, -1 if a is a quadratic
  2728. // nonresidu mod p
  2730. Procedure GIntLegendreSymbol(a, p : TGInt; Var L : integer);
  2731. Var
  2732.    temp1, temp2, temp3, temp4, temp5, zero, one : TGInt;
  2733.    i : integer;
  2734.    ok1, ok2 : boolean;
  2735. Begin
  2736.    DecStrToGInt('0', zero);
  2737.    DecStrToGInt('1', one);
  2738.    GIntMod(a, p, temp1);
  2739.    If GIntCompareabs(zero, temp1) = Eq Then
  2740.    Begin
  2741.       GIntDestroy(temp1);
  2742.       L := 0;
  2743.    End
  2744.    Else
  2745.    Begin
  2746.       GIntDestroy(temp1);
  2747.       GIntCopy(p, temp1);
  2748.       GIntCopy(a, temp2);
  2749.       L := 1;
  2750.       While GIntCompareAbs(temp2, one) <> Eq Do
  2751.       Begin
  2752.          If (temp2^.value Mod 2) = 0 Then
  2753.          Begin
  2754.             GIntSquare(temp1, temp3);
  2755.             GIntSub(temp3, one, temp4);
  2756.             GIntDestroy(temp3);
  2757.             GIntDivByInt(temp4, temp3, 8, i);
  2758.             If (temp3^.value Mod 2) = 0 Then ok1 := false Else ok1 := true;
  2759.             GIntDestroy(temp3);
  2760.             GIntDestroy(temp4);
  2761.             If ok1 = true Then L := L * (-1);
  2762.             GIntDivByInt(temp2, temp3, 2, i);
  2763.             GIntDestroy(temp2);
  2764.             temp2 := temp3;
  2765.          End
  2766.          Else
  2767.          Begin
  2768.             GIntSub(temp1, one, temp3);
  2769.             GIntSub(temp2, one, temp4);
  2770.             GIntMul(temp3, temp4, temp5);
  2771.             GIntDestroy(temp3);
  2772.             GIntDestroy(temp4);
  2773.             GIntDivByInt(temp5, temp3, 4, i);
  2774.             If (temp3^.value Mod 2) = 0 Then ok2 := false Else ok2 := true;
  2775.             GIntDestroy(temp5);
  2776.             GIntDestroy(temp3);
  2777.             If ok2 = true Then L := L * (-1);
  2778.             GIntMod(temp1, temp2, temp3);
  2779.             GIntDestroy(temp1);
  2780.             temp1 := temp2;
  2781.             temp2 := temp3;
  2782.          End;
  2783.       End;
  2784.       GIntDestroy(temp1);
  2785.       GIntDestroy(temp2);
  2786.    End;
  2787.    GIntDestroy(zero);
  2788.    GIntDestroy(one);
  2789. End;
  2791. End.