Bac 2009 8h30

Program bac2009;
Uses Wincrt;
Var
  f: Text;
  n: Longint;

Procedure creation (Var f:Text);
Begin
  Assign (f,'c:\bac\super_p.txt');
End;

Procedure saisie (Var n:Longint);
Begin
  Repeat
    Write ('Saisir N: ');
    Readln (n);
  Until (40000<n) And (n<1000000);
End;
Function premier (ch:String): Boolean;
Var
  n,i: Longint;
  r,e: Integer;
Begin
  Val (ch,n,e);
  r := 0;
  For i:=1 To n Do
    If (n Mod i=0) Then
      r := r+1;
  premier := r=2;
End;
Function super (n:Longint): Boolean;
Var
  ch: String;
  test: Boolean;
Begin
  Str (n,ch);
  Repeat
    test := premier(ch);
    ch := Copy(ch,1,Length(ch)-1);
  Until (ch='') Or (test=False);
  super := test;
End;

Procedure traitement (Var f:Text;n:Integer);
Var
  i: Longint;
Begin
  Rewrite (f);
  For i:=1 To n Do
    If (super(i)) Then
      Begin
        Writeln ('Super premier ',i);
        Writeln (f,'Super premier ',i);
      End;
  Close (f);
End;
Begin
  creation (f);
  saisie (n);
  traitement (f,n);
End.