Hex - Binary - Long (decimal) Conversions

[anhn]

Other experts may have other ways to do these conversions.

Sub Test1()
    Debug.Print Bin2Lng("111100010101001000")
    Debug.Print Bin2Lng("11 1100 0101 0100 1000")
    Debug.Print Bin2Lng("&B111100010101001000")
    Debug.Print
    Debug.Print Bin2LngA("111100010101001000")
    Debug.Print Bin2LngA("11 1100 0101 0100 1000")
    Debug.Print Bin2LngA("&B111100010101001000")
    Debug.Print
    Debug.Print Bin2Hex("111100010101001000")
    Debug.Print Bin2Hex("11 1100 0101 0100 1000")
    Debug.Print Bin2Hex("&B111100010101001000")
    Debug.Print
    Debug.Print Bin2HexA("111100010101001000")
    Debug.Print Bin2HexA("11 1100 0101 0100 1000")
    Debug.Print Bin2HexA("&B111100010101001000")
    Debug.Print
    Debug.Print Lng2Bin(-12345)
    Debug.Print Lng2Bin(-12345, " ")
    Debug.Print Lng2Bin(12345, " ")
    Debug.Print Lng2Bin(12345)
    Debug.Print
    Debug.Print Hex2Bin("5FC8DE")
    Debug.Print Hex2Bin("5FC8DE", " ")
End Sub

Function Bin2Lng(ByVal sBin As String) As Long
    Dim i As Long, n As Long, bt() As Byte
    
    '-- remove spaces if exists
    If InStrB(sBin, " ") Then sBin = Replace(sBin, " ", "")
    '-- remove leading "&B" if exists
    If Left$(sBin, 2) = "&B" Then sBin = Mid$(sBin, 3)
    '-- make sure binary string contains only 0 and 1
    If sBin Like "*[!01]*" Then Err.Raise 13 '-- type mismatch
    '-- find highest 1-bit
    i = InStr(sBin, "1")
    If i = 0 Then Bin2Lng = 0: Exit Function '-- all bits are 0's
    '-- remove leading 0's
    If i > 1 Then sBin = Mid$(sBin, i)
    '-- make sure binary string contains maximum of 32 digits
    '(1)
    If Len(sBin) < 32 Then     '-- positive number
        bt = sBin              '   convert string to byte array
    ElseIf Len(sBin) = 32 Then '-- negative number:
        Bin2Lng = &H80000000   '   preset to "largets" negative number
        bt = Mid$(sBin, 2)     '   then remove highets bit and
                               '   convert string to byte array
    Else             '-- has more than 32 bits:
        Err.Raise 6  '   overflow
    End If
    '-- convert byte array to number (ignore high-bytes)
    For i = 0 To UBound(bt) Step 2
        n = n * 2 + bt(i) - 48 '-- bt(i)=48 for "0" or =49 for "1"
    Next
    '(2) other ways to convert
    'Select Case Len(sBin)
    '    Case Is < 32: i = 1                       '-- positive number
    '    Case 32:      i = 2: Bin2Lng = &H80000000 '-- negative number
    '    Case Is > 32: Err.Raise 6                 '-- overflow
    'End Select
    'For i = i To Len(sBin)
        'n = n * 2 + Asc(Mid$(sBin, i)) - 48
        'n = n * 2 + Asc(Mid$(sBin, i, 1)) - 48
        'n = n * 2 + CLng(Mid$(sBin, i, 1))
        'n = n * 2 + Mid$(sBin, i, 1)
        'n = n * 2 - (Mid$(sBin, i, 1) = "1")
    'Next
    Bin2Lng = Bin2Lng + n
End Function

Function Bin2Hex(ByVal sBin As String) As String
    Bin2Hex = Hex(Bin2Lng(sBin))
End Function

Bin2HexA() and Bin2LngA() are another way around of the pair Bin2Hex() and Bin2Lng()

    
Function Bin2HexA(ByVal sBin As String) As String
    Dim i As Long, n As Long, arNibs() As String, sNib As String
    
    '-- remove spaces if exists
    If InStrB(sBin, " ") Then sBin = Replace(sBin, " ", "")
    '-- remove leading "&B" if exists
    If Left$(sBin, 2) = "&B" Then sBin = Mid$(sBin, 3)
    '-- make sure binary string contains only 0 and 1
    If sBin Like "*[!01]*" Then Err.Raise 13 '-- type mismatch
    '-- remove leading 0's if exists
    Do While Len(sBin) > 1 And Left$(sBin, 1) = "0": sBin = Mid$(sBin, 2): Loop
    n = Len(sBin)
    '-- make sure binary string contains maximum 32 digits
    If n > 32 Then Err.Raise 6 '-- overflow
    '-- patch leading 0 to fill nibbles (groups of 4 bits)
    If n Mod 4 > 0 Then sBin = String$(4 - n Mod 4, "0") & sBin
    '-- convert each nibble to hex
    arNibs = Split("0000,0001,0010,0011,0100,0101,0110,0111," & _
                   "1000,1001,1010,1011,1100,1101,1110,1111", ",")
    For i = 1 To Len(sBin) Step 4
        sNib = Mid$(sBin, i, 4)
        For n = 0 To 15
            If sNib = arNibs(n) Then Bin2HexA = Bin2HexA & Hex(n): Exit For
        Next
    Next
End Function

Function Bin2LngA(ByVal sBin As String) As Long
    Bin2LngA = CLng("&H" & Bin2HexA(sBin))
End Function

Function Hex2Bin(ByVal sHex As String, Optional ByteSep As String) As String
    Dim arNibs() As String, i As Long, j As Long
    
    arNibs = Split("0000,0001,0010,0011,0100,0101,0110,0111," & _
                   "1000,1001,1010,1011,1100,1101,1110,1111", ",")
    '-- convert each Hex digit to nibble and add byte separator if required
    For i = 1 To Len(sHex)
        j = CLng("&H" & Mid$(sHex, i, 1))
        Hex2Bin = Hex2Bin & ByteSep & arNibs(j)
    Next
    If Len(ByteSep) Then '-- remove extra leading separator
        Hex2Bin = Mid$(Hex2Bin, Len(ByteSep) + 1)
    Else '-- remove leading 0's
        i = InStr(Hex2Bin, "1")
        If i > 1 Then Hex2Bin = Mid$(Hex2Bin, i)
    End If
End Function

Function Lng2Bin(ByVal n As Long, Optional ByteSep As String) As String
    Dim sHex As String, arNibs() As String, sBin As String, i As Long, j As Long
    
    If n = 0 Then
        If Len(ByteSep) Then Lng2Bin = "0000" Else Lng2Bin = "0"
        Exit Function
    End If
    arNibs = Split("0000,0001,0010,0011,0100,0101,0110,0111," & _
                   "1000,1001,1010,1011,1100,1101,1110,1111", ",")
    '-- convert Long to Hex
    sHex = Hex(n)
    '-- convert each Hex digit to nibble and add byte separator if required
    For i = 1 To Len(sHex)
        j = CLng("&H" & Mid$(sHex, i, 1))
        Lng2Bin = Lng2Bin & ByteSep & arNibs(j)
    Next
    If Len(ByteSep) Then '-- remove extra leading separator
        Lng2Bin = Mid$(Lng2Bin, Len(ByteSep) + 1)
    Else '-- remove leading 0's
        i = InStr(Lng2Bin, "1")
        If i > 1 Then Lng2Bin = Mid$(Lng2Bin, i)
    End If
End Function

'-- this function should not be here, use in line code is better
Function Hex2Lng(ByVal sHex As String) As Long
    If Left$(sHex, 2) <> "&H" Then sHex = "&H" & sHex
    Hex2Lng = CLng(sHex)
End Function

'-- of course, this function is not required: that is Hex() function
Function Lng2Hex(ByVal n As Long) As String
    Lng2Hex = Hex(n)
End Function

[anhn]

Some people misunderstood of function CDec():

CDec() is a function to convert a value of any data type that can be recognised as a number to subtype Decimal of type Variant.
A Decimal subtype value can hold up to 28 digits (left+right of decimal point).
Ex.:

Dim d1 As Variant, d2 As Variant
d1 = CDec("1234567890123456789012345678")
d2 = CDec(123456789012345#) * CDec(678901.2345678#)

Hex$() is a function to convert a Long to a String under Hexadecimal notation that uses 16 digits 0...9A...F.

Ex.: "1F" is Hex String of Long integer 31

&H30A is another way to write 778 in VB: n = &H30A and n = 778 mean exactly the same thing in VB.

In case if we have an arbitrary String under Hex format and want to convert to a Long value, this is the way to convert a Hex String to a Long:

Dim S As String, n As Long, H as String
S = "30A" 
n = CLng("&H" & S) ' = 778
'-- and convert back a Long to Hex String:
H = Hex$(n + 20) ' = Hex$(798) = "31E"