Uses DOS; Var res : array [1..37] of longint; cursimple : longint; nums : longint; tmp : byte; num,j : longint; cur : longint; timestart,timeend,timetot : longint; hour,minute,second,sec100 : word; Procedure FindNextSimple; Var exitF : boolean; i : longint; Begin repeat ExitF := false; if cursimple in [1..2] then inc(cursimple) else inc(cursimple,2); for i := 2 to round(sqrt(cursimple)) do if cursimple mod i = 0 then ExitF := true; until not ExitF; End;{FindNextSimple} {--------------------------------} Begin Write('Введите число: '); ReadLn(nums); GetTime(hour,Minute,Second,sec100); timestart := hour*3600; timestart := timestart+minute*60; timestart := timestart+second; for j := 2 to nums do begin cur := 1; cursimple := 1; num := j; While num <> 1 do begin FindNextSimple; while num mod cursimple = 0 do begin num := num div cursimple; res[cur] := cursimple; inc(cur); end; end; tmp :=1; While res[tmp] <> 0 do begin Write(res[tmp],' '); res[tmp] := 0; inc(tmp); end end; GetTime(hour,minute,second,sec100); timeend := hour*3600; timeend := timeend+minute*60; timeend := timeend+second; timetot := timeend - timestart; hour := timetot div 3600; timetot := timetot - hour*3600; minute := timetot div 60; timetot := timetot - minute*60; second := timetot; WriteLn; Write('Время просчета: ',Hour,' часов ',Minute,' минут ',second,' секунд'); ReadLn End.