program Cryptage;
uses wincrt;
type
mat=array[1..20,1..10]of char;
var
f,fcr:text;
cle:string;
m:mat;
l:integer;
function verif(ch:string):boolean;
var
i:integer;
begin
	i:=1;
	while(i<=length(ch)) and (ch[i] in ['A'..'Z']) do
	i:=i+1;
	verif:=i>length(ch);
	end;
function distinct(ch:string):boolean;
var
v:boolean;
i:integer;
begin
	i:=1;
	repeat
	i:=i+1;
	v:=pos(ch[i],copy(ch,1,i-1))=0;
	until not(v) or (i=length(ch));
	distinct:=v;
	end;
procedure saisie( var cle:string);
begin
	repeat
	write('saisir un mot cle constituee de lettres majuscules distinctes de longueur entre 5 et 10 : ');
	readln(cle);
	until (length(cle)>=5) and (length(cle)<=10) and (verif(cle)) and (distinct(cle));
end;
procedure rempm(var m:mat;var fcr:text;i:integer;var l:integer);
var
j,c:integer;
ch:string;
begin
reset(fcr);
	l:=1;
	while not eof(fcr) do
	begin
		readln(fcr,ch);
while(i mod (length(ch))<>0) do
ch:=ch+' ';
		for j:=1 to length(ch) do
		begin
	for c:= 1 to i do
	begin
	m[c,l]:=ch[j];
	if (c=i) then
	l:=l+1;
end;
end;
end;
close(fcr);
	end;
procedure crypter(var m:mat;var fcr,f:text;cle:string;var l:integer);
begin
	reset(fcr);
	rewrite(f);
	rempm(m,fcr,length(cle),l);
	close(fcr);
	close(f);
end;
procedure affiche(var f:text);
var
ch:string;
begin
	reset(f);
	while (not(eof(f))) do
	begin
		readln(f,ch);
		writeln(ch);
    end;
    close(f);
end;
procedure affmat(m:mat;l,c:integer);
var
i,j:integer;
begin
	for i:= 1 to l do
	begin
	for j:= 1 to c do
	writeln(m[l,c]);
	end;
	end;

begin
	assign(fcr,'C:\BAC2020\Sources.txt');
	assign(f,'C:\BAC2020\Crypt.txt');
	saisie(cle);
	crypter(M,fcr,f,cle,l);
	affmat(m,l,length(cle));
	affiche(f);
end.