bac 2019 (solution final)

program tpbac2019;
uses wincrt;
var
    n:integer;
    f:text;

procedure saisir(var n:integer);
begin
    repeat
        write('Saisir n : ');
        readln(n);
    until (n in [2..100]);
end;

procedure saisie(var x:integer);
begin
    repeat
        write('Saisir un entier : ');
        readln(x);
    until (x > 0) and (x < 1000);
end;

procedure trait(var f:text; n:integer);
var
    i,a,b,x,y,d:integer;
    p:longint;
    ok1,ok2:boolean;
begin
    rewrite(f);
    for i:=1 to n do
    begin
        saisie(a);
        saisie(b);
        x := a;
        y := b;
        p := 1;
        d := 2;
        repeat
            ok1 := a mod d = 0;
            ok2 := b mod d = 0;
            if ok1 or ok2 then
            begin
                p := p * d;
                if ok1 then
                    a := a div d;

                if ok2 then
                    b := b div d;
            end
            else
                d := d + 1;
        until (a = 1) and (b = 1);

        writeln(f, 'PPCM(',x,', ',y,') = ', p);
    end;
    close(f);
end;

procedure affiche(var f:text);
var ch:string;
begin
    reset(f);
    while not(eof(f)) do
    begin
        readln(f, ch);
        writeln(ch);
    end;
end;

begin
    assign(f, 'ppcm.txt');
    saisir(n);
    trait(f, n);
    affiche(f);
    close(f);
end.