Program S3;
Uses crt;
Type
fdonnee = file Of string[100];
Var
ft : text;
fd : fdonnee;
n : integer;
//*************************************
Function verif(ch:String) : boolean;
Var
i : integer;
ok : boolean;
Begin
ok := true;
i := 1;
While (ok) And (i<=length(ch)) Do
If (ch[i] In ['0'..'9','A'..'F']) Then
i := i+1
Else
ok := false;
verif := ok;
End;
//*************************************
Function base(ch:String) : integer;
Var
v,max,e,i : integer;
Begin
If (ch[1] In ['0'..'9']) Then
val(ch[1],max,e)
Else
max := ord(ch[1])-64;
For i:=2 To length(ch) Do
Begin
If (ch[i]In ['0'..'9']) Then
val(ch[i],v,e)
Else
v := ord(ch[i])-55;
If (max<v) Then
max := v;
End;
base := max+1;
End;
//*************************************
Function puiss(a,n:integer) : integer;
Var
p,i : integer;
Begin
p := 1 ;
For i:=1 To n Do
p := p*a;
puiss := p;
End;
//*************************************
Function convert(ch:String;b:integer) : string;
Var
chc : string;
v,e,dec,i : integer;
Begin
dec := 0;
For i:=1 To length(ch) Do
If (ch[i] In ['0'..'9']) Then
Begin
val(ch[i],v,e);
dec := dec+v*puiss(b,length(ch)-i);
End
Else
Begin
v := ord(ch[i])-55;
dec := dec+v*puiss(b,length(ch)-i);
End;
str(dec,chc);
convert := chc;
End;
//*************************************
Procedure transfert(Var fd:fdonnee; Var ft:text;
n:integer);
Var
ligne,chb,res,ch : string[100];
b,i : integer;
Begin
reset(fd);
rewrite(ft);
For i:=1 To n Do
Begin
read(fd,ch);
b := base(ch);
res := convert(ch,b);
str(b,chb);
ligne := '('+ch+')'+chb+'=('+res+')10';
writeln(ft,ligne);
End;
close(fd);
close(ft);
End;
//*************************************
Procedure remplir(Var fd:fdonnee; n:integer);
Var
ch : string;
i : integer;
Begin
rewrite(fd);
For i:=1 To n Do
Begin
Repeat
writeln('Saisir une chaine : ');
readln(ch);
Until (length(ch)In [1..5]) And (verif(ch));
write(fd,ch);
End;
close(fd);
End;
Procedure affiche(Var ft:text; n:integer);
Var
i : integer;
ligne : string;
Begin
reset(ft);
For i:=1 To n Do
Begin
readln(ft, ligne);
writeln(ligne);
End;
close(ft);
End;
//*************************************
Begin
assign(fd,'c:\nb_base.dat');
assign(ft,'c:\nombre.txt');
Repeat
write('saisir n: ');
readln(n);
Until n In [2..10];
remplir(fd,n);
transfert(fd,ft,n);
affiche(ft,n);
End.
Inscription à :
Publier les commentaires (Atom)
