1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
| program bac2009;
uses wincrt;
var
super_p:text;
N:longint;
procedure saisie(var n :longint);
begin
repeat
writeln('donner votre intervalle svp');
readln(n);
until (n>40000) and (n<100000);
end;
function premier (x:integer):boolean;
var test:boolean; i:integer;
begin
test:=true;
i:=1;
repeat
i:=i+1;
if (x mod 2 = 0) then
test:=false;
until (i=x div 2) or (test=false);
premier:=test;
end;
function superpremier (k:integer):boolean;
var i:integer;a:integer;ch:string;e:integer;verif:boolean;
begin
i:=0;
repeat
STR(k,ch);
a:=length(ch);
if (premier(k)=true) then
begin
delete(ch,a,1);
verif:=true;
val(ch,k,e);
end
else
verif:=false;
until (verif=false) or (length(ch)=0);
superpremier:=verif;
end;
procedure remplir (var super_p:text;n:longint);
var p:integer;ch:string;
begin
rewrite(super_p);
for p:=1 to n do
begin
if (superpremier(p)=true) then
STR(p,ch);
writeln(super_p,ch);
end;
close(super_p);
end;
procedure affiche (var super_p:text);
var h:string;i:integer;
begin
Reset(super_p);
while not eof(super_p) do
begin
i:=i+1;
readln(super_p,h);
writeln('le i nombre est',i);
end;
close(super_p);
end;
begin
assign(super_p,'c:/programmation/super_p.txt');
saisie(n);
remplir (super_p,n);
affiche(super_p);
end. |
Partager