sa

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
  Rewrite(f);
  rempm(m,fcr,Length(cle),l);
  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:\Users\platpot\Desktop\arfizato\progg\pascal\Projects\Source.txt');
assign(f,'C:\Users\platpot\Desktop\arfizato\progg\pascal\Projects\Crypt.txt');
ReWrite(fcr);
close(fcr);
  saisie(cle);
  crypter(M,fcr,f,cle,l);
  affmat(m,l,Length(cle));
  affiche(f);
End.