Bac 2012 (8h30) (Long)

Program bac2012;
Uses Wincrt;
Var
  f1,f2: Text;

Procedure creation (Var f1,f2:Text);
Begin
  Assign (f1,'c:\bac\Nombres.txt');
  Assign (f2,'c:\bac\Facteurs.txt');
End;

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

Procedure remplir (Var f1:Text);
Var
  n,i,p: Integer;
  ch: String;
Begin
  Rewrite (f1);
  Repeat
    Write ('Saisir N: ');
    Readln (n);
    Write ('Saisir P: ');
    Readln (p);
  Until (2<n) And (n<100) And (2<p) And (p<6);
  For i:=1 To n Do
    Begin
      Repeat
        Writeln ('Saisir l''entier ',i,': ');
        Readln (ch);
      Until (verif(ch)) And (Length(ch)=p);
      Writeln (f1,ch);
    End;
  Close (f1);
End;

Function fact (ch:String): String;
Var
i,n,e:integer;
ch1:string;
Begin
  Val (ch,n,e);
  i := 2;
    ch:='';
  Repeat
        if (n mod i=0) Then
            Begin
                n:=n div i;
                str (i,ch1);
                ch:=ch+ch1+',';
            end
        Else
            i:=i+1;
  Until (n=1);
    fact:=ch;
End;

Function crypt (ch:String): String;
Var
  c,ch1,ch2: String;
  x: Integer;
Begin
  ch := fact(ch);
  ch1 := '';
  Repeat
    c := Copy (ch,1,Pos(',',ch)-1);
    x := 0;
    While (Copy (ch,1,Pos(',',ch)-1)=c) Do
      Begin
        x := x+1;
        Delete (ch,1,Pos(',',ch));
      End;
    Str (x,ch2);
    ch1 := ch1+ch2+c;
  Until (ch='');
  crypt := ch1;
End;
Procedure traitement (Var f1,f2:Text);
Var
  ch: String;
Begin
  Reset (f1);
  Rewrite (f2);
  While Not(Eof(f1)) Do
    Begin
      Readln (f1,ch);
      Writeln (f2,crypt(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);
    remplir (f1);
    traitement (f1,f2);
    affiche (f2);
End.