Brouillon #1

Program beta;
Uses Wincrt;
Type
  base = Array [0..32767] Of String;
Var
  f: Text;
  a,b: Integer;

Procedure creation (Var f:Text);
Begin
  Assign (f,'C:\bac\prog\Beta\Bin.txt');
End;

Procedure saisie (Var a,b:Integer);
Begin
  Repeat
    Writeln ('Saisir a et b ');
    Readln (a);
    Readln (b);
  Until (10<a) And (a<b) And (b<10000);
End;

Function distnul (i:Integer): Boolean;
Var
  test: Boolean;
  ch: String;
  j: Integer;
Begin
  Str (i,ch);
  j := 0;
  Repeat
    j := j+1;
    test := (ch[j]<>ch[j+1]) And ((ch[j]<>'0') And (ch[j+1]<>'0'));
  Until (test=False) Or (j=Length(ch)-1);
  distnul := test;
End;

Function divis (i:Integer): Boolean;
Var
  e,j,x: Integer;
  test: Boolean;
  ch: String;
Begin
  j := 0;
  Str (i,ch);
  Repeat
    j := j+1;
    Val (ch[j],x,e);
    test := i Mod x =0;
  Until (test=False) Or (Length(ch)=j);
  divis := test;
End;

Procedure remplir (Var f:Text;a,b:Integer);
Var
  i: Integer;
Begin
  Rewrite (f);
  For i:=a To b Do
    If (distnul (i)) And (divis(i)) Then
      Writeln (f,i,' est un nombre extraordinaire');
  Close (f);
End;

Procedure affiche (Var t:Text);
Var
  ch: String;
Begin
  Reset (f);
  If Eof(f) Then
    Writeln ('Il y''a r');
  While Not (Eof(f)) Do
    Begin
      Readln (f,ch);
      Writeln (ch);
    End;
End;
Begin
  creation (f);
  saisie (a,b);
  remplir (f,a,b);
  affiche (f);
  Close (f);
End.