bac 2019 (prob)(theo)

Program bac19pb;
Uses Wincrt;
Type
  tab = Array ['A'..'G','A'..'F'] Of Char;
Var
  m1,m2: tab;
  mot,msg: String;

Function verif1 (ch:String): Boolean;
Var
  i: Integer;
  test: Boolean;
Begin
  i := 0;
  Repeat
    i := i+1;
    test := ch[i] In ['a'..'z','0'..'9',' '];
  Until (i=Length(ch)) Or (test=false);
  verif1 := test;
End;

Function verif2 (ch:String): Boolean;
Var
  i: Integer;
  test: Boolean;
Begin
  i := 0;
  Repeat
    i := i+1;
    test := ch[i] In ['A'..'Z'];
  Until (i=Length(ch)) Or (test=false);
  verif2 := test;
End;

Procedure saisie (Var msg,mot:String);
Begin
  Repeat
    Write ('Saisir le msg: ');
    Readln (msg);
  Until (Length(msg)<=18) And (verif1(msg));
  Repeat
    Write ('Saisir le mot clé: ');
    Readln (mot);
  Until (Length(mot)=6) And (verif2(mot));
End;

Procedure remplir (Var m1:tab);
Var
  i,j: Char;
    f:text;
Begin
  Assign (f,'C:\bac\matrice.txt');
  Reset (f);
  For i:='A' To 'F' Do
    For j:='A' To 'F' Do
      Readln (f,m1[i,j]);
  Close (f);
End;

Function position (c:Char;m:tab): String;
Var
i,j:char;
Begin
  For i:='A' To 'F' Do
    For j:='A' To 'F' Do
      If m[i,j]=c Then position := i+j;
End;
Procedure tri_bul (Var t:tab);
Var
  i,aux,j,n: char;
Begin
n:='F';
  Repeat
        For i:='A' To chr(ord(n)-1) Do
        If t['A',i]>t['A',succ(i)] Then
          Begin
            for j:='A' to 'G' Do
                            Begin
                                aux := t[j,i];
                    t[j,i] := t[j,succ(i)];
                    t[j,succ(i)] := aux;
                            end;
          End;
    n := chr(ord(n)-1);
  Until n=pred('A');
End;
Procedure traitement (m1:tab;Var m2:tab;msg,mot:String);
Var
  x: Integer;
  ch: String;
    i,j:char;
Begin
  ch := '';
  For x:=1 To Length(msg) Do
    If msg[x]=' ' Then
      ch := ch+' '
    Else
      ch := ch+position(msg[x],m1);
        for i:='A' to 'F' Do
            m2['A',i]:=mot[ord(i)-64];
        x:=0;
        for i:='B' to 'G' Do
            for j:='A' to 'F' Do
                Begin
                    x:=x+1;
                    m2[i,j]:=ch[x];
                end;
        tri_bul(m2);
        ch:='';
            for j:='A' to 'F' Do
                for i:='B' to 'G' Do
                ch:=ch+m2[i,j];
        writeln (ch);
End;
Begin
  saisie (msg,mot);
  remplir (m1);
  traitement (m1,m2,msg,mot);
End.
{
    c
1
o
f
w
j
y
m
t
5
b
4
i
7
a
2
8
s
p
3
0
q
h
x
k
e
u
l
6
d
v
r
g
z
n
9
}