home *** CD-ROM | disk | FTP | other *** search
/ RBBS in a Box Volume 1 #3.1 / RBBSIABOX31.cdr / qbas / pub_key.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-09-30  |  9.3 KB  |  337 lines
  1.  
  2. PROGRAM PRIMES;
  3. VAR
  4.    PRIME       :  BOOLEAN;
  5.    I,J,K,N,MAX : INTEGER;
  6.    L, SQU      : INTEGER;
  7.    P           : ARRAY[1..1296] OF INTEGER;
  8.    U           : ARRAY[1..36] OF INTEGER;
  9. BEGIN
  10.    WRITELN('PROGRAM TO DETERMINE THE FIRST N PRIME INTEGERS');
  11.    WRITELN;
  12.    WRITELN('ENTER N, THE DESIRED NUMBER OF PRIME INTEGERS: MAX = 3512');
  13.    READLN(N);
  14.    P[1] := 2;   L := 1;   SQU := 4;   MAX := 1;
  15.    FOR I := 2 TO N + 10 - (N MOD 10) DO
  16.        BEGIN
  17.            REPEAT
  18.                L := L+2;
  19.                IF SQU <= L THEN
  20.                    BEGIN
  21.                        U[MAX] := SQU;
  22.                        MAX := MAX+1;
  23.                        SQU := P[MAX]*P[MAX]
  24.                     END;
  25.                K := 2;  PRIME := TRUE;
  26.                WHILE PRIME AND (K<MAX) DO
  27.                    BEGIN
  28.                        IF U[K] < L THEN U[K] := U[K] + P[K];
  29.                        PRIME := (L <> U[K]);
  30.                        K := K+1
  31.                    END;
  32.            UNTIL PRIME;
  33.            P[I] := L;
  34.            IF (I MOD 10 = 0) THEN
  35.                BEGIN
  36.                    IF I > N THEN
  37.                        BEGIN
  38.                            WRITELN;
  39.                            FOR J := I-9 TO N DO WRITE(P[J], '  ');
  40.                        END
  41.                     ELSE
  42.                     BEGIN
  43.                        WRITELN;
  44.                        FOR J := I-9 TO I DO WRITE(P[J], '  ');
  45.                     END;
  46.                END;
  47.            END;
  48. END.
  49.  
  50.                (*  Listing 1   Prime Number Program  *)
  51.  
  52.  
  53.  
  54.  
  55.  
  56. PROGRAM RANDOM;
  57. VAR A,X,M,R  : INTEGER[36];
  58.           N  : INTEGER;
  59. BEGIN
  60.    WRITELN('PROGRAM TO GENERATE A SEQUENCE OF PSUEDO RANDOM NUMBERS');
  61.    WRITELN;
  62.    WRITELN('ENTER NUMBER OF INTEGERS DESIRED');
  63.    READLN(N);
  64.    WRITELN;
  65.    A := 4294967299;
  66.    M := 184467440737095516;
  67.    WRITELN('ENTER SEED INTEGER:  SHOULD BE PRIME FOR MAXIMUM PERIOD');
  68.    READLN(X);
  69.    WRITELN;
  70.    WHILE N>0 DO
  71.        BEGIN
  72.            X := A*X;
  73.            R := X DIV M;
  74.            X := X-R*M;
  75.            WRITELN(X);
  76.            N := N-1;
  77.        END
  78. END.
  79.  
  80.  
  81.               (*  Listing 2  Random Integer Generator  *)
  82.  
  83. PROGRAM RAND16;
  84. VAR A,X,M,R  : INTEGER[36];
  85.           N  : INTEGER;
  86. BEGIN
  87.    WRITELN('PROGRAM TO GENERATE A SEQUENCE OF PSUEDO RANDOM NUMBERS');
  88.    WRITELN;
  89.    WRITELN('ENTER NUMBER OF INTEGERS DESIRED');
  90.    READLN(N);
  91.    WRITELN;
  92.    WRITELN('ENTER ODD SEED INTEGER < 32767');
  93.    READLN(X);
  94.    WRITELN;
  95.    WHILE N>0 DO
  96.        BEGIN
  97.            X := 181*X;
  98.            IF X<0 THEN X := X+32767+1;
  99.            WRITELN(X);
  100.            N := N-1
  101.         END
  102.   END.
  103.  
  104.           (*  Listing 3  16-bit Random Integer Generator *)
  105.  
  106.  
  107.  
  108. PROGRAM EXP1;
  109. VAR A,A1,AMOD,B,P,P1,PROD,R: INTEGER[36];
  110. BEGIN
  111.    WRITELN('PROGRAM FOR FINDING (A EXP (B-1)/2) MOD B');
  112.    WRITELN;
  113.    WRITELN('ENTER B, THE MODULUS');
  114.    READLN(B);
  115.    WRITELN('ENTER A SUCCESSION OF TEST INTEGERS:  ');
  116.    WRITELN('ENTER ZERO TO TERMINATE');
  117.    WRITELN;
  118.    READLN(A);
  119.    A1 := A;
  120.    WHILE A>0 DO
  121.        BEGIN
  122.            WRITELN;
  123.            PROD := 1;
  124.            P := (B-1) DIV 2;
  125.            AMOD := A;
  126.            WHILE P>0 DO
  127.                BEGIN
  128.                    P1 := P;
  129.                    P := P DIV 2;
  130.                    IF (2*P) <> P1 THEN
  131.                        BEGIN
  132.                            PROD := PROD*AMOD;
  133.                            R := PROD DIV B;
  134.                            PROD := PROD-B*R
  135.                        END;
  136.                    AMOD := AMOD*AMOD;
  137.                    R := AMOD DIV B;
  138.                    AMOD := AMOD-B*R
  139.                END;
  140.            IF PROD = 1 THEN
  141.                WRITELN('THE MODULAR EXPONENTIAL IS +1')
  142.            ELSE
  143.                IF (B-PROD)=1 THEN
  144.                    WRITELN('THE MODULAR EXPONENTIAL IS -1')
  145.                ELSE
  146.                    WRITELN('THE MODULAR EXPONENTIAL IS ', PROD);
  147.            WRITELN;
  148.            WRITELN('========================================');
  149.            READLN(A);
  150.            A1 := A
  151.        END
  152. END.
  153.  
  154.               (*  Listing 4  Modular Exponentiation Program  *)
  155.  
  156.  
  157.  
  158. PROGRAM PRIMTEST;
  159. VAR
  160.    A,B,B1,R   : INTEGER[36];
  161.    SGN,N,N1   : INTEGER;
  162. BEGIN
  163.    WRITELN('PROGRAM FOR TESTING ODD INTEGERS FOR PRIMALITY');
  164.    WRITELN;
  165.    WRITELN('ENTER B, THE NUMBER TO BE TESTED');
  166.    READLN(B1);
  167.    WRITELN('ENTER NUMBER OF TEST INTEGERS');
  168.    READLN(N1);
  169.    N := N1;
  170.    WHILE N>0 DO
  171.        BEGIN
  172.            B := B1;
  173.            WRITELN('NUMBER TO BE TESTED IS ', B);
  174.            WRITELN('ENTER TEST INTEGER A<B');
  175.            READLN(A);
  176.            WHILE B1<(A+1) DO
  177.                BEGIN
  178.                    WRITELN('INVALID TEST INTEGER.... TRY AGAIN!');
  179.                    READLN(A);
  180.                END;
  181.            WRITELN;
  182.            SGN := 1;
  183.            WHILE A>1 DO
  184.                BEGIN
  185.                    IF ((A DIV 2)*2) <> A THEN
  186.                        BEGIN
  187.                            R := B DIV A;
  188.                            R := B-R*A;
  189.                            IF (((A-1) DIV 4)*2)<>((A-1) DIV 2) THEN
  190.                                IF (((B-1) DIV 4)*2) <> ((B-1) DIV 2) THEN
  191.                                    SGN := -SGN;
  192.                            B := A;  A := R
  193.                        END
  194.                     ELSE
  195.                        BEGIN
  196.                            A := A DIV 2;
  197.                            IF (((B-1) DIV 4)*2) = ((B-1) DIV 2) THEN
  198.                                IF (((B-1) DIV 8)*2) <> ((B-1) DIV 4) THEN
  199.                                    SGN := -SGN
  200.                                ELSE SGN := SGN
  201.                            ELSE
  202.                                IF (((B+1) DIV 8)*2) <> ((B+1) DIV 4) THEN
  203.                                    SGN := -SGN
  204.                                ELSE
  205.                                    SGN := SGN
  206.                        END
  207.                END;
  208.                IF A = 1 THEN
  209.                    BEGIN
  210.                        WRITELN('GCD = 1; J = ', SGN);
  211.                        WRITELN('======================================');
  212.                        WRITELN
  213.                    END;
  214.                IF A=0 THEN
  215.                    BEGIN
  216.                        WRITELN('GCD = ', B);
  217.                        WRITELN('         NUMBER IS NOT PRIME');
  218.                        WRITELN('++++++++++++++++++++++++++++++++++++++')
  219.                    END;
  220.                N := N-1
  221.        END
  222. END.
  223.  
  224.                 (*  Listing 5   Primality Test   *)
  225.  
  226.  
  227.  
  228.  
  229. PROGRAM EUCLID;
  230. VAR
  231.        A,B,B1,R : INTEGER[36];
  232. BEGIN
  233.    WRITELN('PROGRAM TO FIND GREATEST COMMON DENOMINATOR GCD(A,B)');
  234.    WRITELN;
  235.    WRITELN('ENTER VALUE OF B');
  236.    READLN(B1);
  237.    WRITELN;
  238.    WRITELN('ENTER A VALUES IN SUCCESION');
  239.    WRITELN('ENTER ZERO TO TERMINATE');
  240.    WRITELN;
  241.    READLN(A);
  242.    WHILE A>0 DO
  243.        BEGIN
  244.            WHILE A>0 DO
  245.                BEGIN
  246.                    B := B1;
  247.                    R := B DIV A;
  248.                    R := B-R*A;
  249.                    B := A;
  250.                    A := R;
  251.                 END;
  252.            WRITELN('                            ', B);
  253.            WRITELN('---------------------------------------------------');
  254.            READLN(A)
  255.        END
  256. END.
  257.  
  258.                (*  Listing 6   Euclid's Algorithm    *)
  259.  
  260.  
  261.  
  262. PROGRAM MULINV;
  263. VAR
  264.    M,M1,N,Q,U,V,Y,Z : INTEGER[36];
  265. BEGIN
  266.    WRITELN('PROGRAM FOR FINDING U SUCH THAT, FOR GIVEN V, V*U MOD M=1');
  267.    WRITELN;
  268.    WRITELN('ENTER V');
  269.    READLN(V);
  270.    WRITELN('ENTER M');
  271.    READLN(M);
  272.    M1 := M;
  273.    U := 1;
  274.    Y:= 0;
  275.    WHILE M>0 DO
  276.        BEGIN
  277.            Q := V DIV M;
  278.            Z := Y;
  279.            N := M;
  280.            Y := U-Q*Y;
  281.            U := Z;
  282.            M := V-Q*M;
  283.            V := N;
  284.        END;
  285.        IF U<0 THEN U := M1+U;
  286.        IF V<>1 THEN WRITELN('V AND M ARE NOT RELATIVELY PRIME')
  287.        ELSE WRITELN('V AND M ARE RELATIVELY PRIME:  VALUE OF U IS ',U);
  288. END.
  289.  
  290.        (* Listing 7   Modular Multiplicative Inverse Program   *)
  291.  
  292.  
  293.  
  294. PROGRAM ENCRYPT;
  295. VAR
  296.    E,E1,E2,N,P,PMOD,PROD,R  : INTEGER[36];
  297. BEGIN
  298.    WRITELN('THIS PROGRAM IMPLEMENTS THE RSA ALGORITHM');
  299.    WRITELN('FOR ENCRYPTING OR DECRYPTING');
  300.    WRITELN;
  301.    WRITELN('ENTER THE MODULUS N');
  302.    READLN(N);
  303.    WRITELN;
  304.    WRITELN('ENTER KEY FOR ENCRYPTING OR DECRYPTING');
  305.    READLN(E);
  306.    WRITELN;
  307.    WRITELN('ENTER INTEGERS TO BE ENCODED IN SUCCESSION');
  308.    WRITELN('ENTER ZERO TO TERMINATE');
  309.    READLN(P);
  310.    E2 := E;
  311.    WHILE P>0 DO
  312.        BEGIN
  313.            E := E2;
  314.            PROD := 1;
  315.            PMOD := P;
  316.            WHILE E>0 DO
  317.                BEGIN
  318.                    E1 := E;
  319.                    E := E DIV 2;
  320.                    IF (2*E) <> E1 THEN
  321.                    BEGIN
  322.                        PROD := PROD*PMOD;
  323.                        R := PROD DIV N;
  324.                        PROD := PROD-R*N;
  325.                    END;
  326.                    PMOD := PMOD*PMOD;
  327.                    R := PMOD DIV N;
  328.                    PMOD := PMOD-R*N
  329.                END;
  330.            WRITELN('                         ', PROD);
  331.            WRITELN('========================================');
  332.            READLN(P)
  333.        END
  334. END.
  335.  
  336.               (* Listing 8  RSA Encryption-Decryption Program *)
  337.