Bac 2019 (méthode perso)

Program bac2019;
Uses Wincrt;
Type
  pp = Record
    a,b,ppcm: Integer;
  End;
  tab = Array [1..100] Of pp;
Var
  t: tab;
  n: Integer;

Procedure remplir (Var t:tab;Var n:Integer);
Var
  i: Integer;
Begin
  Repeat
    Write ('Saisir N: ');
    Readln (n);
  Until (2<=n) And (n<=100);
  For i:=1 To n Do
    With t[i] Do
      Begin
        Repeat
          Write ('Saisir A: ');
          Readln (a);
        Until (0<a) And (a<1000);
        Repeat
          Write ('Saisir B: ');
          Readln (b);
        Until (0<b) And (b<1000);
      End;
End;

Function repet (c:String;ch:String): String;
Var
  i,s: Integer;
Begin
  s := 0;
  Repeat
    If Copy(ch,i,Length(c))=c Then
      s := s+1;
    Delete (ch,1,Pos('*',ch));
  Until ch='';
  Str (s,ch);
  repet := ch;
End;

Function facteur (a:Integer): String;
Var
  i,e,x: Integer;
  ch,ch1,c: String;
Begin
  i := 1;
  ch1 := '';
  Repeat
    i := i+1;
    If a Mod i =0 Then
      Begin
        a := a Div i;
        Str(i,ch);
        ch1 := ch1+ch+'*';
        i := 1;
      End;
  Until (a Div i=0);
  ch := '';
  Repeat
    c := Copy (ch1,1,Pos('*',ch1)-1);
    ch := ch+c+'_'+repet(c,ch1)+'*';
    Val (repet(c,ch1),x,e);
    Delete (ch1,1,Length(Copy(ch1,1,Pos('*',ch1)))*x);
  Until (ch1='');
  Delete (ch,Length(ch),1);
  facteur := ch;
End;

Function puis (a,b:Integer): Integer;
Var
  i,x: Integer;
Begin
  x := a;
  For i:=1 To b-1 Do
    a := a*x;
  puis := a;
End;

Function calcul (ch:String): Integer;
Var
  s,a,b,e: Integer;
Begin
  s := 1;
  ch := ch+'*';
  Repeat
    Val (Copy(ch,1,Pos('_',ch)-1),a,e);
    Val (Copy(ch,Pos('_',ch)+1,Pos('*',ch)-Pos('_',ch)-1),b,e);
    If puis(a,b)<>0 Then
      s := s*puis(a,b);
    Delete (ch,1,Pos('*',ch));
  Until (ch='');
  calcul := s;
End;
Function propre (ch1,ch2:String): String;
Var
  ch: String;
Begin
  ch := ch1+'*';
  ch2 := ch2+'*';
  Repeat
    If Pos(Copy(ch2,1,Pos('_',ch2)),ch)=0 Then
      Begin
        ch := ch+Copy(ch2,1,Pos('*',ch2)-1)+'*';
        Delete (ch2,1,Pos('*',ch2));
      End
    Else
      If Copy(ch2,Pos('_',ch2)+1,1)>Copy (ch,Pos(Copy(ch2,1,2),ch)+2,1) Then
        Begin
          Delete (ch,Pos(Copy(ch2,1,2),ch),4);
          ch := ch+Copy(ch2,1,3)+'*';
          Delete (ch2,1,Pos('*',ch2));
        End
    Else
      Delete (ch2,1,Pos('*',ch2));
  Until (ch2='');
  propre := ch;
End;
Procedure traitement (Var t:tab;n:Integer);
Var
  i: Integer;
  ch: String;
Begin
  For i:=1 To n Do
    With t[i] Do
      ppcm := calcul (propre(facteur (a),facteur (b)));
End;
Procedure affiche (t:tab;n:Integer);
Var
  i: Integer;
Begin
  For i:=1 To n Do
    With t[i] Do
      Writeln ('Le PPCM (',a,',',b,') = ',ppcm);
End;
Begin
  remplir (t,n);
  traitement (t,n);
  affiche (t,n);
End.