Matematické Fórum

program PrvociselnyRozklad;

//Napiste program, ktery pro zadane prirozene cislo
//spocita prvociselny rozklad a zapise vysledek do textoveho souboru.


uses zapis;

var
  i,prv: integer;


begin
writeln('Program, ktery pro zadane prirozene cislo spocita prvociselny rozklad, pro konec zadejte nulu');
writeln('Zadejte cislo: ');


repeat
readln(i);
if i=0 then break else
if i<0 then writeln('Program pracuje jen s prirozenymi cisly.') else
prv:=2;
zapisprv(i);     //procedura pro zapis prvocisla
zapisrvn;        // procedura pro zapis =

write(' = ');
if i=1 then begin write(i); zapisprv(i); zapismezeru;  end else
begin
  while i<>1 do
    begin

      while (i mod prv)=0 do             
          begin
            write(prv);
            zapisprv(prv);
            i:=i div prv;                
            if i>1 then begin zapistxt('*'); write('*'); end;
          end;
    prv:=prv+1;
    end;
    zapismezeru;
end;
 writeln;
until i=0;
end.

unit zapis;




interface
 procedure zapisprv(co: integer);
 procedure zapistxt(co: char);
 procedure zapisrvn;
 procedure zapismezeru;
implementation
 procedure zapisprv(co: integer);
 var f: text;
begin
  AssignFile(f, 'pokus.txt');

   {$I-}
  append(f);
  {$I+}
  if (IOResult <> 0) then
  begin
   {$I-}
   rewrite(f);
    {$I+}
    if(IOResult <>0) then
    begin
      writeln('soubor neni mozne otevrit pro zapis,vzdavam to');
      exit;
    end;
  end;
  write(f, co);
  close(f);
end;


 procedure zapistxt(co: char);
  var f: text;
 begin
   AssignFile(f, 'pokus.txt');
   append(f);
   write(f, co);
   close(f);
 end;

 procedure zapismezeru;
  var f: text;
 begin
   AssignFile(f, 'pokus.txt');
   append(f);
   writeln(f);
   close(f);
 end;

 procedure zapisrvn;
  var f: text;
 begin
   AssignFile(f, 'pokus.txt');
   append(f);
   write(f, ' = ');
   close(f);
 end;
end.