Devoir de contrôle 2

Program Cryptage;
Uses Wincrt;
Var
  f1,f2: Text;
Procedure creation (Var f1,f2:Text);
Begin
  Assign (f1,'c:\bac\Messages.txt');
  Assign (f2, 'c:\bac\Mess_Crypt.txt');
End;
Function premier (ch:String): Boolean;
Var
  r,i,n: Integer;
Begin
  n := Length(ch);
  r := 0;
  For i:=1 To n Div 2 Do
    If n Mod i = 0 Then
      r := r+1;
  premier := r>1;
End;
Function alpha (ch:String): Boolean;
Var
  i: Integer;
  test: Boolean;
Begin
  i := 0;
  Repeat
    i := i+1;
    test := ch[i] In ['A'..'Z'];
  Until (test=False) Or (i=Length(ch));
  alpha := test;
End;

Procedure saisie (Var f1:Text);
Var
  n,i: Integer;
  m: String;
Begin
  Rewrite (f1);
  Repeat
    Writeln ('Saisir N:');
    Readln (n);
  Until (n<=50) And (n>=1);
  For i:=1 To n Do
    Begin
      Repeat
        Writeln ('Saisir le message ',i,' : ');
        Readln (m);
      Until (Length(m)>4) And (premier(m)) And (alpha (m));
      Writeln (f1,m);
    End;
  Close (f1);
End;
function divis (ch:string):string;
Var
ch1:string;
n,i:integer;
Begin
n:=Length(ch);
ch:='';
for i:=2 to n div 2 Do
    if n mod i =0 Then
    Begin
        str (i,ch1);
        ch:=ch+ch1+',';
    end;
divis:=ch;
end;
function invers (ch:string;x:integer):string;
Var
ch1:string;
i:integer;
Begin
    ch1:='';
    repeat
        for i:=x downto 1 Do
            ch1:=ch1+ch[i];
        delete (ch,1,x);
    Until ch='';
invers:=ch1;
end;
Procedure traitement (Var f1,f2:Text);
Var
n,ch,ch1:string;
e,x,i:integer;
Begin
  Reset (f1);
  Rewrite (f2);
  While Not(Eof(f1)) Do
    Begin
            readln (f1,ch);
            ch1:=divis(ch);
            for i:=1 to Length(ch1) div 2 Do
                Begin
                    val (copy(ch1,1,Pos(',',ch1)-1),x,e);
                    delete (ch1,1,pos(',',ch1));
                    ch:=invers(ch,x);
                end;
                writeln (f2,'Le message crypté est: ',ch);
        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 (f1);
    traitement (f1,f2);
    affiche (f2);
End.