Bac 2010 14H30

Program bac201414h;
Uses Wincrt;
Var
  f,f2: Text;
Procedure creation (Var f,f2:Text);
Begin
  Assign (f,'c:\bac\nb_nombres.txt');
  Assign (f2,'c:\bac\nombre.txt');
End;
Function verif (ch:String): Boolean;
Var
  test: Boolean;
  i: Integer;
Begin
  i := 0;
  Repeat
    i := i+1;
    test := ch[i] In ['0'..'9','A'..'F'];
  Until (test=False) Or (i=Length(ch));
  verif := test;
End;
Procedure remplir (Var f:Text);
Var
  ch: String;
  n,i: Integer;
Begin
  Repeat
    Write ('Saisir n: ');
    Readln (n);
  Until (n<=10) And (1<=n);
  Clrscr;
  Rewrite (f);
  For i:=1 To n Do
    Begin
      Repeat
        Write ('Saisir la chaine ',i,': ');
        Readln (ch);
      Until (Length(ch)<=5) And (verif(ch));
      Writeln (f,ch);
      Clrscr;
    End;
  Close (f);
End;
Function base (ch:String): Integer;
Var
  max: Char;
  e,i,b: Integer;
Begin
  max := ch[1];
  For i:=2 To Length(ch) Do
    If ch[i]>max Then
      max := ch[i];
  If (max In ['A'..'F']) Then
    b := Ord(max)-55
  Else
    Val (max,b,e);
  base := b+1;
End;

Function convert (ch:String;b:Integer): Integer;
Var
  s,i,p,e: Integer;
Begin
  s := 0;
  p := 1;
  For i:=Length (ch) Downto 1 Do
    Begin
      If ch[i] In ['A'..'F'] Then
        Begin
          s := s+p*(Ord(ch[i])-55);
          p := b*p;
        End
      Else
        Begin
          s := s+p*(Ord(ch[i])-48);
          p := b*p;
        End;
    End;
  convert := s;
End;

Procedure traitement (Var f,f2:Text);
Var
  ch: String;
  b: Integer;
Begin
  Reset (f);
  Rewrite (f2);
  While Not (Eof(f)) Do
    Begin
      Readln (f,ch);
      b := base (ch);
      Writeln (f2,'(',ch,')',b,' = (',convert(ch,b),')10');
    End;
  Close (f);
  Close (f2);
End;

Procedure affiche (Var f2:Text);
Var
  ch: String;
Begin
  Reset (f2);
  While Not (Eof(f2)) Do
    Begin
      Readln (f2,ch);
      Writeln (ch);
    End;
  Close (f2);
End;
Begin
  creation (f,f2);
  remplir (f);
  traitement (f,f2);
  affiche (f2);
End.