15 мая "Исходники.РУ" отмечают 20-летие присутствия в сети!
Поздравляем всех причастных и неравнодушных с юбилеем сайта!
И огромное спасибо всем, кто был с нами все эти годы!

Главная Информер Журнал Форум Wiki DRKB Discuz!ML Помощь проекту


Функции HexToInt, IntToBin и BinToInt.

Компилятор: Delphi 5.x (или выше)

В Delphi есть функция IntToHex, однако нет функции HexToInt. Так же в юните sysutils отсутствуют бинарные функции IntToBin и BinToInt.

В примерах используется тип Int64, однако без труда можно переделать примеры под любую версию Delphi.

{ ======================================= }
{ Преобразование значения HexString в Int64 }
{ Замечание: Последний символ может быть 'H' для Hex  }
{        т.е. '00123h' или '00123H'    }
{ В случае неправильной HexString будет возвращён 0 }
{ ======================================= }

function HexToInt(HexStr : string) : Int64;
var RetVar : Int64;
    i : byte;
begin
  HexStr := UpperCase(HexStr);
  if HexStr[length(HexStr)] = 'H' then
     Delete(HexStr,length(HexStr),1);
  RetVar := 0;
  
  for i := 1 to length(HexStr) do begin
      RetVar := RetVar shl 4;
      if HexStr[i] in ['0'..'9'] then
         RetVar := RetVar + (byte(HexStr[i]) - 48)
      else
         if HexStr[i] in ['A'..'F'] then
            RetVar := RetVar + (byte(HexStr[i]) - 55)
         else begin
            Retvar := 0;
            break;
         end;
  end;
  
  Result := RetVar;
end;

{ ============================================== }
{ Преобразование значения Int64 в бинарную строку }
{ NumBits может быть 64,32,16,8 для указания  }
{ представления возвращаемого значения (Int64,DWord,Word }
{ или Byte) (по умолчанию = 64) }
{ Обычно NumBits требуется только для отрицательных   }
{ входных значений }
{ ============================================== }

function IntToBin(IValue : Int64; NumBits : word = 64) : string;
var RetVar : string;
    i,ILen : byte;
begin
RetVar := '';

case NumBits of
      32 : IValue := dword(IValue);
      16 : IValue := word(IValue);
      8  : IValue := byte(IValue);
end;

while IValue <> 0 do begin
    Retvar := char(48 + (IValue and 1)) + RetVar;
    IValue := IValue shr 1;
end;

if RetVar = '' then Retvar := '0';
Result := RetVar;
end;


{ ============================================== }
{ Преобразование бинарной строки в значение Int64 }
{ Замечание: Последний символ может быть 'B' для Binary  }
{        т.е. '001011b' или '001011B'   }
{ В случае неправильной бинарной строки будет возвращён 0  }
{ ============================================== }

function BinToInt(BinStr : string) : Int64;
var i : byte;
    RetVar : Int64;
begin
   BinStr := UpperCase(BinStr);
   if BinStr[length(BinStr)] = 'B' then Delete(BinStr,length(BinStr),1);
   RetVar := 0;
   for i := 1 to length(BinStr) do begin
     if not (BinStr[i] in ['0','1']) then begin
        RetVar := 0;
        Break;
     end;
     RetVar := (RetVar shl 1) + (byte(BinStr[i]) and 1) ;
   end;
  
   Result := RetVar;
end;

 

-----------------------------------------------------------------------------------------------------------

Другие варианты этих функций:

BinToInt:

function BinToInt (BinStr: string) : Int64;
var
   I, Len: integer;
const
   Mask: int64 = 1;
begin
   Result := 0;

   Len := Length (BinStr);
   if (UpperCase (BinStr [Len]) = 'B') then begin
      Dec (Len);
   end; {if}

   for I := 1 to Len do begin
      case BinStr [I] of
         '0':
           begin
              {ничего не делаем}
           end;
         '1':
           begin
              Result := Result OR (Mask SHL (Len - I))
           end;
      else begin
              raise Exception.Create ('Wrong binary string');
           end;
      end; {case}
   end; {for I}
end;

 

 

Преобразование 32-битного целого в бинарное число:

function Base10(Base2:Integer) : Integer; assembler;
asm
  cmp    eax,100000000            // проверяем верхний предел
  jb     @1                        // ok
  mov    eax,-1                    // флаг ошибки
  jmp    @exit                    // выходим с -1
@1:
  push    ebx                      // сохраняем регистры
  push   esi
  xor    esi,esi                  // результат = 0
  mov    ebx,10                    // делим по основанию 10
  mov    ecx,8
@2:
  mov    edx,0
  div    ebx
  add    esi,edx
  ror    esi,4
  loop @2
  mov    eax,esi                  // результат функции
  pop    esi                      // восстанавливаем регистры
  pop    ebx
@exit:
end;