Bac 2017

Program bac2017;
Uses Wincrt;
Type
  tab = Array [1..10,1..10] Of Char;
Var
  f1,f2: Text;
  cle: String;

Procedure creation (Var f1,f2:Text);
Begin
  Assign (f1,'c:\bac\source.txt');
  Assign (f2,'c:\bac\result.txt');
End;

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

Procedure saisie (Var cle :String);
Begin
  Repeat
    Write ('Saisir la clé: ');
    Readln (cle);
  Until (verif (cle)) And (Length(cle) In [5..10]);
End;
Function cryptage (ch,cle:String): String;
Var
  i,j,x: Integer;
  t: tab;
Begin
  x := 0;
  For i:=1 To (Length(ch) Div Length(cle)) Do
    For j:=1 To Length(cle) Do
      Begin
        x := x+1;
        t[i,j] := ch[x];
      End;
    x:=Length(ch);
    ch:='';
    For j:=1 To Length(cle) Do
        Begin
            ch:=ch+cle[j];
            For i:=1 To (x Div Length(cle)) Do
                    ch:=ch+t[i,j];
        end;
    cryptage:=ch;
End;
Procedure traitement (Var f1,f2:Text;cle:String);
Var
  i,n: Integer;
  ch: String;
Begin
  Reset (f1);
  Rewrite (f2);
  While Not (Eof(f1)) Do
    Begin
      n := Length(cle)-(Length(ch) Mod Length(cle));
      Readln (f1,ch);
      If n<>0 Then
        For i:=1 To n Do
          ch := ch+' ';
      Writeln (f2,cryptage(ch,cle));
    End;
  Close (f1);
  Close (f2);
End;
procedure affiche (var f2:text);
Var
ch:string;
Begin
    reset (f2);
    while not (eof(f2)) Do
    Begin
        readln (f2,ch);
        writeln (ch);
    end;
    close (f2);
end;
Begin
  creation (f1,f2);
  saisie (cle);
  traitement (f1,f2,cle);
    affiche (f2);
End.