M1RAI

ex3_conv_bin_hex_bac_2010_principale

Apr 24th, 2020
947
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1.  program conv_bin_hex;
  2.  uses wincrt;
  3.  var
  4.  ch:string;
  5.  
  6.  
  7. function verif(ch:string):Boolean;
  8. Var i:integer;
  9. begin
  10.         i:=1;
  11.         while (ch[i] in ['1','0']) AND (i <= length(ch)) do
  12.             i:=i+1;
  13.         verif:= i > length(ch);
  14. end;
  15.  
  16.  
  17.  
  18. procedure saisie(var ch:string);
  19. begin
  20.         repeat
  21.             write('ch=');
  22.             readln(ch);
  23.         until (ch <> '') AND (verif(ch));
  24. end;
  25.  
  26.  
  27. function conv_10_b(x:integer;b:byte):string;
  28. var R:integer;
  29. ch,ch1:string;
  30. begin
  31.          ch:='';
  32.          Repeat
  33.                 R:= X mod b;
  34.                 if R>= 10 then ch1:=ord(R+55)
  35.                 else str(R,ch1);
  36.                 ch:=ch1+ch;
  37.                 x:= x div b;
  38.           until x = 0;
  39. end;
  40.  
  41.  
  42.  
  43.  
  44.  
  45. function conv(ch:string):string;
  46. Var
  47. ch_hex,bloc:string;
  48. i,x,e,bloc_dec:integer;
  49. begin
  50.             ch_hex:='';
  51.             repeat
  52.                 i:=length(ch);
  53.                 bloc:='';
  54.                 Repeat
  55.                             if length(ch) >= 4 then
  56.                             begin
  57.                                 bloc:=ch[i] + bloc;
  58.                                 i:=i-1;
  59.                             end
  60.                             else
  61.                             Repeat
  62.                                 ch:='0'+ ch;
  63.                             until length(ch) = 4;
  64.                 until length(bloc) = 4;
  65.                 val(bloc,x,e);
  66.                 bloc_dec:=conv_bloc(x);
  67.                 ch_hex:= conv_10_b(x,15) + ch_hex;
  68.                 delete(ch,i,4);
  69.             until ch='';
  70. end;
  71.  
  72.  
  73. begin
  74.     saisie(ch);
  75.     write('la conversion en hexadeciaml est : ',conv(ch));
  76. end.
RAW Paste Data