Examen du baccalauréat - Session de Juin 2012

Program FactPrem;
Uses Wincrt;
Var
  f1,f2: Text;
Type
tab=array [1..50] of integer;
Procedure creation (Var f1,f2:Text);
Begin
  Assign (f1,'c:/bac/Nombres.txt');
  Assign (f2,'c:/bac/Facteurs.txt');
End;

Procedure facpremier (Var t:tab;n:Integer;Var j:Integer);
Var
  i: Integer;
  ch: String;
  x: String;
Begin
  i := 2;
  j := 1;
  Repeat
    If n Mod i = 0 Then
      Begin
        t[j] := i;
        j := j+1;
        n := n Div i;
      End
    Else
      i := i+1;
  Until n=1;
  j := j-1;
End;

Procedure remplir (Var f1:Text);
Var
  n,x,i: Integer;
  ch: String;
Begin
  Rewrite (f1);
  Repeat
    Writeln ('Saisir le nombre d''entiers: ');
    Readln (n);
  Until (2<n) And (n<100);
  For i:=1 To n Do
    Begin
      Repeat
        Writeln ('Saisir l''entier ',i,' : ');
        Readln (x);
        Str (x,ch);
      Until (2<Length(ch)) And (Length(ch)<6);
      Writeln (f1,ch);
    End;
  Close (f1);
End;
Function comptage (n:Integer;t:tab;ch:Integer): Integer;
Var
  x: Integer;
  i: Integer;
Begin
  x := 0;
  For i:=1 To ch Do
    If n=t[i] Then
      x := x+1;
  comptage := x;
End;
Procedure traitement (Var f1,f2:Text);
Var
  t: tab;
  x: Integer;
    j,i:integer;
    aux1,aux2,aux,final:string;

Begin
  Reset (f1);
  Rewrite (f2);
    While Not (Eof(f1)) Do
    Begin
      Readln (f1,x);
                facpremier (t,x,j);
                final:='';
      For i:=1 To j Do
        Begin
          Str (comptage (t[i],t,j),aux1);
          Str (t[i],aux2);
          aux := aux1+aux2;
          final := final+aux;
          If comptage (t[i],t,j)>1 Then
            i := i+comptage (t[i],t,j)-1;
        End;
      Writeln (f2,x,' : ',final);
    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);
  remplir (f1);
  traitement (f1,f2);
  affiche (f2);
End.