{$R-}
UNIT HexWrite;
(**) INTERFACE (**)
TYPE HexString = ShortString;
  BinString = ShortString;

  FUNCTION HexByte(B : Byte) : HexString;
  FUNCTION HexShortInt(S : ShortInt) : HexString;
  FUNCTION HexWord(W : Word) : HexString;
  FUNCTION HexInteger(I : Integer) : HexString;
  FUNCTION HexLongInt(L : LongInt) : HexString;
  FUNCTION HexPointer(VAR P) : HexString;

  FUNCTION BinByte(B : Byte) : BinString;
  FUNCTION BinShortInt(S : ShortInt) : BinString;
  FUNCTION BinWord(W : Word) : BinString;
  FUNCTION BinInteger(I : Integer) : BinString;
  FUNCTION BinLongInt(L : LongInt) : BinString;

  FUNCTION NumBin(B : BinString) : LongInt;
  FUNCTION ANumBin(B : BinString) : LongInt;
(**) IMPLEMENTATION (**)
CONST
  HexDigits : Packed ARRAY[0..15] OF Char = '0123456789ABCDEF';
  BinNibbles : ARRAY[0..15] OF ARRAY[0..3] OF Char = (
    '0000', '0001', '0010', '0011',
    '0100', '0101', '0110', '0111',
    '1000', '1001', '1010', '1011',
    '1100', '1101', '1110', '1111');

  FUNCTION HexByte(B : Byte) : HexString;
  VAR Temp : HexString;
  BEGIN
    Temp[0] := #2;
    Temp[1] := HexDigits[B SHR 4];
    Temp[2] := HexDigits[B AND $F];
    HexByte := Temp;
  END;

  FUNCTION HexShortInt(S : ShortInt) : HexString;
  BEGIN HexShortInt := HexByte(Byte(S)); END;

  FUNCTION HexWord(W : Word) : HexString;
  VAR Temp : HexString;
  BEGIN
    Temp[0] := #4;
    Temp[1] := HexDigits[W SHR 12];
    Temp[2] := HexDigits[(W SHR 8) AND $F];
    Temp[3] := HexDigits[(W SHR 4) AND $F];
    Temp[4] := HexDigits[W AND $F];
    HexWord := Temp;
  END;

  FUNCTION HexInteger(I : Integer) : HexString;
  BEGIN HexInteger := HexWord(Word(I)); END;

  FUNCTION HexLongInt(L : LongInt) : HexString;
  VAR Temp : HexString;
  BEGIN
    Temp[0] := #8;
    Temp[1] := HexDigits[(L SHR 16) Shr 12];
    Temp[2] := HexDigits[((L Shr 16) SHR 8) AND $F];
    Temp[3] := HexDigits[((L Shr 16) SHR 4) AND $F];
    Temp[4] := HexDigits[(L SHR 16) AND $F];
    Temp[5] := HexDigits[(L SHR 12) AND $F];
    Temp[6] := HexDigits[(L SHR 8) AND $F];
    Temp[7] := HexDigits[(L SHR 4) AND $F];
    Temp[8] := HexDigits[L AND $F];
    HexLongInt := Temp;
  END;

  FUNCTION HexPointer(VAR P) : HexString;
  VAR
    Temp : HexString;
    L    : LongInt ABSOLUTE P;
  BEGIN
    Temp := HexLongInt(L);
    Move(Temp[5], Temp[6], 4);
    Temp[5] := ':';
    Inc(Temp[0]);
    HexPointer := Temp;
  END;

  FUNCTION BinByte(B : Byte) : BinString;
  VAR Temp : BinString;
  BEGIN
    Temp[0] := #8;
    Move(BinNibbles[B SHR 4], Temp[1], 4);
    Move(BinNibbles[B AND $F], Temp[5], 4);
    BinByte := Temp;
  END;

  FUNCTION BinShortInt(S : ShortInt) : BinString;
  BEGIN BinShortInt := BinByte(Byte(S)); END;

  FUNCTION BinWord(W : Word) : BinString;
  VAR Temp : BinString;
  BEGIN
    Temp[0] := #16;
    Move(BinNibbles[W SHR 12], Temp[1], 4);
    Move(BinNibbles[(W SHR 8) AND $F], Temp[5], 4);
    Move(BinNibbles[(W SHR 4) AND $F], Temp[9], 4);
    Move(BinNibbles[W AND $F], Temp[13], 4);
    BinWord := Temp;
  END;

  FUNCTION BinInteger(I : Integer) : BinString;
  BEGIN BinInteger := BinWord(Word(I)); END;

  FUNCTION BinLongInt(L : LongInt) : BinString;
  VAR Temp : BinString;
  BEGIN
    Temp[0] := #32;
    Move(BinNibbles[(L SHR 12) Shr 16], Temp[1], 4);
    Move(BinNibbles[((L SHR 8) Shr 16) AND $F], Temp[5], 4);
    Move(BinNibbles[((L SHR 4) Shr 16) AND $F], Temp[9], 4);
    Move(BinNibbles[(L SHR 16) AND $F], Temp[13], 4);
    Move(BinNibbles[(L SHR 12) AND $F], Temp[17], 4);
    Move(BinNibbles[(L SHR 8) AND $F], Temp[21], 4);
    Move(BinNibbles[(L SHR 4) AND $F], Temp[25], 4);
    Move(BinNibbles[L AND $F], Temp[29], 4);
    BinLongInt := Temp;
  END;

  FUNCTION NumBin(B : BinString) : LongInt;
  VAR Accum, Power : LongInt;
    P : Byte;
  BEGIN
    Power := 1; Accum := 0;
    FOR P := length(B) DOWNTO 1 DO
      BEGIN
        IF B[P] = '1' THEN Inc(Accum, Power);
        Power := PoweR SHL 1;
      END;
    NumBin := Accum;
  END;

  FUNCTION ANumBin(B : BinString) : LongInt; Assembler;
  ASM
    MOV   EDI, B
    XOR   ECX, ECX
    MOV   CL, [EDI]
    ADD   EDI, ECX
    MOV   EAX, 0
    MOV   EDX, 0
    MOV   EBX, 1
    MOV   ESI, 0
@LOOP:
    CMP   BYTE PTR [EDI],'1'
    JNE   @NotOne
    ADD   EAX, EBX   {add power to accum}
    ADC   EDX, ESI
@NotOne:
    SHL   ESI, 1      {double power}
    SHL   EBX, 1
    ADC   ESI, 0
    DEC   EDI
    LOOP  @LOOP
  END;

END.
