Функция перевода из шестнадцатеричной двоичную систему счисления и наоборот - Free Pascal

var b, h: string;
 
//проверка корректности двоичного числа
function testb(s: string): boolean;
var i: integer;
begin
  if s[1] = '+' then delete(s, 1, 1); //ведущий "+" удалить
  if length(s) > 8 //если число > 8 символов
    then testb := false //то неверное
    else begin //иначе
      testb := true; //пока верное
      if s[1] = '-' then delete(s, 1, 1); //ведущий "-" удалить
      for i := 1 to length(s) do if not(s[i] in ['0', '1']) //проверяем цифры
        then begin //если цифра не "0" или "1", то
          testb := false; //число неверное
          break //дальше проверять смысл умер, досрочно выходим из цикла
        end
    end
end;
 
//перевод из двоичного в шестнадцатеричное
function bintohex(s: string): string;
//массив шестнадцатеричных цифр, индекс массива соответствует значению цифры
const d: array [0..15] of char = ('0', '1', '2', '3', '4', '5', '6', '7',
                                  '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');
var a, i: integer;
    z: boolean;
begin
  if s[1] = '+' then delete(s, 1, 1); //ведущий "+" удаляем
  if s[1] = '-' //если ведущий "-"
    then begin //то
      z := true; //число отрицательное
      delete(s, 1, 1) //"-" удаляем
    end
    else z := false; //иначе число положительное
  a := 0; //буфер для числа
  for i := 1 to length(s) do //преобразуем строку в число
    begin
      a := a shl 1; //сдвигаем буфер влево, освобождаем место для очередного младшего разряда
      if s[i] = '1' then a := a or 1 //пишем разряд в буфер
    end;
  if z then a := -a; //если число отрицательное - пусть и будет отрицательное
  //переводим:
  //вырезаем соответствующие разряды из буфера числа
  //и используем как индекс для массива шестнадцатеричных цифр
  bintohex := d[(a shr 4) and 15] + d[a and 15]
end;
 
//нормализация шестнадцатеричного числа
procedure normh(var s: string);
var i: integer;
begin
  if s[1] = '+' then delete(s, 1, 1); //убираем ведущий "+"
  for i := 1 to length(s) do //заменяем символы "a".."f" на "A".."F"
    if s[i] in ['a'..'f'] then s[i] := char(byte(s[i]) - byte('a') + byte('A'));
end;
 
//проверка корректности шестнадцатеричного числа
function testh(s: string): boolean;
var i: integer;
begin
  if s[1] in ['+', '-'] then delete(s, 1, 1); //ведущие "+" или "-" удаляем
  if length(s) > 2 //если длина числа > 2 цифр
    then testh := false //то число неверное
    else begin //иначе
      testh := true; //пока число верное
      //если хоть одна цифра не шестнадцатеричная, число неверное
      for i := 1 to length(s) do
        if not(s[1] in ['0'..'9', 'A'..'F']) then testh := false
    end;
end;
 
//перевод одной шестнадцатеричной цифры
function hex1(s: char): integer;
begin
  if s in ['0'..'9']
    then hex1 := byte(s) - byte('0')
    else hex1 := byte(s) - byte('A') + 10
end;
 
//перевод из шестнадцатеричного в двоичное
function hextobin(s: string): string;
var z: boolean;
    a, m: integer;
    b: string;
begin
  if s[1] = '-' //запоминаем знак числа и убираем ведущий "-"
    then begin
      z := true;
      delete(s, 1, 1)
    end
    else z := false;
  if length(s) = 0 //если длина числа 0
    then s := '00' //то число 00
    else if length(s) = 1 //иначе если длина числа 1
      then s := '0' + s; //то число 0s
  a := hex1(s[1]) * 16 + hex1(s[2]); //переводим строку в число
  if z then a := -a; //если число отрицательное
  b := '';
  m := 128; //маска для перевода в двоичную форму: двоичное 10000000 (1 в 8 разряде)
  while m <> 0 do
    begin
      //перевод: выделяем двоичный разряд маской, и пишем соответствующий символ в строку
      if (a and m) <> 0 then b := b + '1' else b := b + '0';
      //сдвигаем маску на следующий разряд
      m := m shr 1
    end;
  hextobin := b //строка готова
end;
 
begin
  repeat //балуемся 2 -> 16
    write('Binary number = ');
    readln(b); //вводим строку
    //если число некорректное, повторяем ввод
    if not(testb(b)) then writeln('Invalid number, reenter.')
  until testb(b);
  h := bintohex(b); //переводим 2 -> 16
  writeln('In hexadecimal = ', h); //печатаем
  repeat //балуемся 16 -> 2
    write('Hexadecimal number = ');
    readln(h); //вводим строку
    normh(h); //нормализуем
    //если число некорректное, повторяем ввод
    if not(testh(h)) then writeln('Invalid number, reenter.')
  until testh(h);
  b := hextobin(h); //переводим 16 -> 2
  writeln('in binary = ', b); //печатаем
  readln
end.