Devoir de controle 1

Program exerciceessai;
Uses Wincrt;
Type
  date = Record
    jour,mois,an: Integer;
  End;
  produit = Record
    code: Integer;
    nom: String;
    dc: date;
  End;
  tab = Array [1..20] Of produit;
Var
  n: Integer;
  t: tab;
    f:text;
procedure creation (Var f:text);
Begin
    Assign (f,'c:\bac\Test Etude\produit.txt');
end;
Function premier (x:Integer): Boolean;
Var
  i,nb: Integer;
Begin
  nb := 0;
  premier := False;
  For i:=x Downto 2 Do
    If (x Mod i) = 0 Then
      nb := nb+1;
  If nb=1 Then
    premier := True;
End;

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

Function distinct (t:tab;n:Integer):Boolean;
Var
  i: Integer;
    test:Boolean;
Begin
  i := 0;
  Repeat
    i := i+1;
    test := t[i].code<>t[i+1].code;
  Until (test=False) Or (i=n-1);
End;

Procedure remplir (Var t:tab;Var n:Integer);
Var
  i: Integer;
  x: String;
  test: Boolean;
Begin
  Repeat
    Randomize;
    n := Random (21);
  Until n>=5;
  Writeln ('L''entier choisi est : ',n);
  For i:=1 To n Do
        With t[i] Do
      Begin
        Repeat
          Write ('Saisir le code du produit ',i,': ');
          Readln (code);
                Until (distinct (t,n)) And (premier(code)=False);
        Repeat
          Write ('Saisir le nom du produit ',i,': ');
          Readln (nom);
        Until (majuspace(nom)) and (nom[1]<>' ');
        With dc Do
          Begin
            Repeat
              Write ('Saisir le jour de création du produit ',i,':');
              Readln (jour);
            Until jour<=31;
            Repeat
              Write ('Saisir le mois de création du produit ',i,':');
              Readln (mois);
            Until mois<=12;
            Repeat
              Write ('Saisir l''an de création du produit ',i,':');
              Readln (an);
              Str (an,x);
            Until Length(x)=4;
          End;
      End;
End;
Procedure affiche (t:tab;n:integer);
Var
i:integer;
Begin
    ClrScr;
    writeln ('Les noms des produits dont le nom commence par une voyelle sont:');
    for i:=1 to n do
        with t[i] Do
        if nom[1] in ['a','e','i','o','u','y'] Then
        writeln (nom);
end;
procedure transfert (var f:text;t:tab;n:integer);
Var
i:integer;
Begin
ReWrite (f);
writeln (f,'Les produits Contruits 4 ans avant 2020 sont: ');
writeln (f,'---------------------------------------------');
for i:=1 to n do
if t[i].dc.an+4=2020 Then
Begin
writeln (f,'Nom: ',t[i].nom);
writeln (f,'Code: ',t[i].code);
writeln (f,'Date de Creation: ',t[i].dc.jour,'/',t[i].dc.mois,'/',t[i].dc.an);
writeln (f,'----------------------');
end;
close (f);
end;
Begin
    creation (f);
    remplir (t,n);
    affiche (t,n);
    transfert (f,t,n);
End.