program cryptage;
uses wincrt;
Type
 strong=string[18];
mat1=array['A'..'F','A'..'F'] of Char;
mat2=array[1..7,1..6] of char;

Var
msg:strong;
mcl:string[6];
M1:mat1;
msgi:string;
M2:mat2;
Function verif(msg:strong):Boolean;
Var
i:Integer;
Begin
i:=1;
while(i<=length(msg)) and (msg[i] in ['0'..'9','a'..'z',' ']) Do
i:=i+1;
verif:=i>length(msg);
end;
	Function verifcl(mcl:String):Boolean;
Var
i:Integer;
Begin
i:=1;
while(i<=length(mcl)) and (mcl[i] in ['A'..'Z']) Do
i:=i+1;
verifcl:=i>length(mcl);
end;
procedure message(var msg:strong);
Begin
Repeat
write(' message a crypter = ');
readln(msg);
Until (length(msg)<=18) and verif(msg);
end;
procedure motcle(var mcl:String);
Begin
Repeat
write('saisir le mot cle : ');
readln(mcl);
Until (Length(mcl)=6) and verifcl(mcl);
end;
procedure init(var M1:mat1);
Var
 i,j,l,c: Char;
  ch: String;
    x : integer;
Begin
  ch := 'abcdefghijklmnopqrstuvwxyz0123456789';
    for l:='A' to 'F' do
        begin
            for c:= 'A' to 'F' do
                begin
                Randomize;
                    x := random(Length(ch))+1;
                m1[l,c] := ch[x];
                Delete(ch,x,1);
                    write(m1[l,c]:4);
                end;
            writeln;
        end;
end;
Procedure affich(M1:mat1);
Var
i,j:char;
Begin
for i:='A' to 'F' Do
Begin
for j:='A'to'F' Do
write(m1[i,j]);
end;
end;
Function generer(var msgi:string;M1:mat1;msg:strong):string;
Var
i,j:char;
l:integer;
ch:string;
Begin
l:=1;
ch:=msg;
msgi:='';
for i:='A' to 'F' Do
Begin
for j:='A' to 'F' Do
Repeat
if(ch[l]<>m1['A','F']) Then
l:=l+1
Else
Begin
msgi:=msgi+i+j;
Delete(ch,l,1);
end;
Until l>Length(ch);
end;
generer:=msgi;
end;
Procedure rempM2(var M2:mat2;mcl:String);
Var
i,j:integer;
Begin
for i:=1 to 7 Do
Begin
for j:=1 to 6 Do
If(msgi<>'') Then
m2[i,j]:=' '
else
Begin
m2[i,j]:=msgi[1];
Delete(msgi,1,1);
end;
end;
end;
procedure tri(var M2:mat2);
Var
aux:Char;
c,j,i:integer;
begin
for j:= 1 to 6 Do
if(m2[1,j+1]<m2[1,j]) Then
Begin
for c:=1 to 7 Do
Begin
aux:=m2[c,j];
m2[c,j]:=m2[c,j+1];
m2[c,j+1]:=aux;
end;
end;
end;
procedure affiche(M2:mat2);
Var
i,j:integer;
ch:string;
begin
ch:='';
for i:= 1 to 6 Do
Begin
for j:= 2 to 7 Do
ch:=ch+m2[j,i];
end;
write(ch);
end;
begin
message(msg);
motcle(mcl);
init(M1);
affich(M1);
generer(msgi,M1,msg);
rempM2(M2,mcl);
tri(m2);
affiche(M2);
end.