program devoir; uses wincrt; type fiche=file of integer; var f:fiche; n,p,q:integer; ch:string; procedure saisir(var p,q:integer); begin repeat writeln('taper p et q: '); readln(p,q); until(p>10)and(q<20000) and(p0)and(i<=n div 2 ) do inc(i); test:= i > n div 2; premier:=test; end; function circuler(ch:string):string; var ch1,ch2:string;e:integer; begin ch1:=ch[length(ch)]; delete(ch,length(ch),1); ch:=ch1+ch; circuler:=ch; end; function verif(ch:string):boolean; var test:boolean;x,e:integer;ch1:string; begin ch1:=ch; repeat ch:=circuler(ch); val(ch,x,e); test:=premier(x); until not(test) or(ch1=ch); verif:=test; end; procedure remplir(var f:fiche;p,q:integer); var k:integer;ch:string; begin for k:=p to q do begin str(k,ch); if verif(ch) then write(f,k); end; end; procedure affiche(var f:fiche); var x:integer; begin clrscr; writeln('Voici le contenu du fichier '); writeln; reset(f); while not(eof(f)) do begin read(f,x); writeln(x); readkey; end; end; begin saisir(p,q); creation(f); remplir(f,p,q); affiche(f); close(f); end.