hobi

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 affmat(m:mat;l,c:Integer);
Var
  i,j: Integer;
Begin
  For i:= 1 To l Do
    Begin
      For j:= 1 To c Do
        Write(m[l,c]);
    End;
        writeln;
End;
Procedure rempm(Var m:mat;Var fcr:Text;i:Integer;Var l:Integer);
Var
  j,c: Integer;
  ch: String;
Begin
  Reset(fcr);
    ReWrite(f);
  l := 1;
    WRITELN(i);
  While Not Eof(fcr) Do
    Begin

      Readln(fcr,ch);
            //writeln('s');
      While ((Length(ch)) Mod I <>0) Do
        ch := ch+' ';

          For c:= 1 To i Do
            Begin
              m[C,L] := ch[1];
                            delete(ch,1,1);
                            write(m[c,l]:4);
              If (c=i) Then
                            BEGIN
                                writeln;
                l := l+1;
                            end;
                            //writeln(l);
            End;

    End;
        //affmat(m,l,i);
  Close(fcr);
    close(f);
End;

Procedure rempf(Var f:Text;m:mat;cle:String;l,c:Integer);
Var
  ch: String;
  q,j,i: Integer;
Begin
  Rewrite(f);
  ch := '';
  For q:= 1 To c Do
    Begin
      For i:= 1 To c Do
        Begin
          ch := ch+cle[q];
          For j:=1 To l Do
            ch := ch+m[c,l];
        End;
    End;
  Close(f);
End;

Procedure crypter(Var m:mat;Var fcr,f:Text;cle:String;Var l:Integer);
Begin
  rempm(m,fcr,Length(cle),l);
            //writeln('d');
  //rempf(f,m,cle,l,Length(cle));
            //writeln('qqqs');
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;

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');
  saisie(cle);
  crypter(M,fcr,f,cle,l);
            //writeln('s');
    //affmat(m,l,Length(cle));
            //writeln('sqqq');
  affiche(f);
            //writeln('ZAZA');
End.