freq_premier_bac_2012

program freq_premier;
uses wincrt;
type
fich=file of integer;
var
f:fich;
ft:text;
N,P,bi,bf:byte;

Procedure saisie(var N:byte; bi,bf:byte);
begin
    repeat
        readln(n);
    until (N>bi) AND (N<bf);
end;

function verif(x:integer;P:byte):Boolean;
var ch:string;
begin
    str(x,ch);
    if(Length(ch) = P) then verif:= TRUE
    else verif:= FALSE;
end;

Procedure rempf(var f:fich; N,P:byte);
var i:byte;
x:integer;
begin
    ReWrite(f);
    for i:=1 to N do
    begin
        repeat
            readln(x);
        until verif(x,P);
        write(f,x);
    end;
    Close(f);
end;





Procedure rempft(var ft:text; var f:fich);
Var
x,i,nb:integer;
chf,chi,freq,chnb:string;
begin
        reset(f);
        ReWrite(ft);
        while not(Eof(f)) do
        begin
                freq:='';
                read(f,x);
                chf:='';
                if x > 1
                then
                begin
                        for i:=2 to x do
                        begin
                                nb:=0;
                                if x mod i = 0 Then
                                repeat
                                    str(i,chi);
                                    chf:=chf+chi+'*';
                                    nb:=nb+1;
                                    x:= x div i;
                                until x mod i <> 0;
                                if nb <> 0
                                then
                                begin
                                    str(nb,chnb);
                                    freq:=freq+chnb+chi;
                                end;
                        end;
                end;
                delete(chf,length(chf),1);
                writeln(ft,chf,' ',freq);
        end;
        close(f);
        close(ft);
end;


procedure aff(var ft:text);
var ch:string;
begin
        reset(ft);
        while not(eof(ft)) do
        begin
            readln(ft,ch);
            writeln(ch);
        end;
        Close(ft);
end;


begin
assign(f,'C:\Pascal\BAC2012\nombres.dat');
Assign(ft,'C:\Pascal\BAC2012\Facteurs.txt');
write('N=');
saisie(N,2,100);
write('P=');
saisie(P,2,6);
rempf(f,n,p);
rempft(ft,f);
aff(ft);
end.