1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110
   | program crypto;
 
uses crt;
 
const 
  fin = 26;
  maxlettre = 'Z';
type  
  tabori = array[1..fin] of char;
  tabin = array[1..fin] of char;
  tabres = array[1..fin] of char;
  tabcomb = array[1..fin] of char;
  tabcode = array[1..fin] of string;
 
var 
  a : tabori;
  b : tabin;
  c : tabres;
  p : tabcomb;
  nomcode : tabcode;
  lettre, reponse : char;
  i, j : integer;
 
begin
 
  for lettre := 'A' to maxlettre do
  begin
    i := 1;
    a[i] := lettre;
    Inc(i, 1);
  end;
  Writeln('Tableau alphabetique initial');
  for i := 1 to fin do
  begin
    Writeln(a[i]);
  end;
 
  for i := 1 to fin do
  begin
    if Odd(i) then 
      b[i] := 'I'
    else 
      b[i] := 'O';
  end;
  for i := 1 to fin do
  begin
    Writeln(b[i]);
  end;
 
  for i := 1 to fin do
  begin
    if Odd(i) then 
      c[i] := a[i + 1]
    else 
      c[i] := a[i];
  end;
 
  for i := 1 to fin do
  begin
    Writeln(c[i]);
  end;
 
  Writeln('Codons le mot que vous souhaitez');
  Writeln('Entrez lettre par lettre le mot en question:');
  for j := 1 to fin do
  begin
    Writeln('Entrez la', j, '-ieme lettre du mot:');
    Readln(reponse);
    p[j] := reponse;
    begin
      a[1] := 'A'; 
      a[fin] := 'Z';
      while (p[j] <> a[1]) and (p[j] <> a[fin]) do
        if p[j] > a[j] then
          repeat
            a[j - 1] := a[j]
          until p[j] = a[j]  
        else
          repeat
            a[j + 1] := a[j];
          until p[j] = a[j];
      if p[j] = a[1] then 
        a[j] := 'A'
      else 
        a[j] := 'Z';
    end;
  end;
 
  for j := 1 to fin do
    Writeln(p[j]);
  Writeln;
 
  for j := 1 to fin do
    Writeln('Ainsi, au rang', j, 'les tableaux p et a correspondent');
  Writeln;
  for j := 1 to fin do
  begin
    if Odd(j) then 
      nomcode[j] := c[j]
    else 
      nomcode[j] := 'sym';
  end;
  Writeln;
  for j := 1 to fin do
    Writeln('Voici le mot apres chiffrage:');
  Writeln('<');
  Write(nomcode[j]);
  Writeln('>');
  Readln;
end. | 
Partager