Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations wOOdy-Soft on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
How to Conver binary data to ASCII-HEX 1
- Thread starter cmlimnet
- Start date
-
1
- #2
Here is some code for you.
Enum base
Bin = 2
Oct = 8
Dec = 10
Hex = 16
End Enum
'-----------------------------------------------------------------------------------------------------------------------
'---------------------------------------------------------START---------------------------------------------------------
Function Dec2Any(ByVal number As Long, ByVal base As base) As String
Dim index As Long
Dim Digits As String
Dim digitValue As Long
On Error GoTo ErrHandler
If base < 2 Or base > 36 Then Err.Raise 5
If number = 0 Then
Dec2Any = "0"
Exit Function
End If
Digits = Left("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ", base)
Do While number
digitValue = number Mod base
number = number \ base
Dec2Any = Mid$(Digits, digitValue + 1, 1) & Dec2Any
Loop
Exit Function
ErrHandler:
'Handle error here
Resume Next
End Function
'----------------------------------------------------------END----------------------------------------------------------
'---------------------------------------------------------START---------------------------------------------------------
Function Any2Dec(ByVal NumberBaseX As String, ByVal base As base) As Long
Dim index As Long
Dim Digits As String
Dim digitValue As Long
On Error GoTo ErrHandler
If base < 2 Or base > 36 Then Err.Raise 5
Digits = Left("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ", base)
For index = 1 To Len(NumberBaseX)
digitValue = InStr(1, Digits, Mid$(NumberBaseX, index, 1), vbTextCompare) - 1
If digitValue < 0 Then Err.Raise 5
Any2Dec = Any2Dec * base + digitValue
Next
Exit Function
ErrHandler:
'Handle error here
Resume Next
End Function
'----------------------------------------------------------END----------------------------------------------------------
'Note: This Function Divides the Binary Number into 4 bit digits to prevent Overflow Error. This
'Allows any Binary Number to be converted with out length restictions. Requires Dec2Any Function
'from Above.
'---------------------------------------------------------START---------------------------------------------------------
Function Bin2Hex(ByVal BinaryNumber As String) As String
Dim index As Integer
Dim Bit As Integer
Dim Digits As Integer
Dim Base10 As Long
Dim BaseHex As String
Dim digit As String
Bit = 0
Base10 = 0
BaseHex = ""
Digits = 0
On Error GoTo ErrHandler
Digits = Len(BinaryNumber) \ 4
If Len(BinaryNumber) Mod 4 <> 0 Then
Digits = Digits + 1
End If
For index = Len(BinaryNumber) To 1 Step -1
digit = Mid$(BinaryNumber, index, 1)
Select Case digit
Case "1"
Base10 = (2 ^ Bit) + Base10
Case "0"
'do nothing
Case Else
Err.Raise 5, , "Number to be Converted is not a Binary Number"
End Select
Bit = Bit + 1
If Bit = 4 Then 'Calculate Hex Value for a single digit
BaseHex = Dec2Any(Base10, Hex) & BaseHex
Bit = 0
Base10 = 0
Digits = Digits - 1
End If
Next
If Digits <> 0 Then 'Calculate Hex Value if bits remaining
BaseHex = Dec2Any(Base10, Hex) & BaseHex
End If
Bin2Hex = BaseHex
Exit Function
ErrHandler:
'Handle error here
Resume Next
End Function
'----------------------------------------------------------END----------------------------------------------------------
'Note: This Function Converts Each Digit of the Hexidecimal input String and Converts it into a Four
'Bit Binary Number. This Forces the Return String to to have leading Zeros. There is No limit to the length
'of the Input Hex or Output Binary Number.
'---------------------------------------------------------START---------------------------------------------------------
Function Hex2Bin(ByVal HexNumber As String) As String
Dim index As Integer
Dim number As Integer
Dim bitValue As Integer
Dim d As Integer
Dim digit As String
Dim BaseBin As String
digit = ""
BaseBin = ""
On Error GoTo ErrHandler
For index = Len(HexNumber) To 1 Step -1
digit = Mid$(HexNumber, index, 1)
Select Case digit
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
number = CInt(digit)
Case "A", "a"
number = 10
Case "B", "b"
number = 11
Case "C", "c"
number = 12
Case "D", "d"
number = 13
Case "E", "e"
number = 14
Case "F", "f"
number = 15
Case Else
Err.Raise 5, , "Number to be Converted is not Hexidecimal"
End Select
For d = 1 To 4
bitValue = number Mod 2
number = number \ 2
BaseBin = Mid$("01", bitValue + 1, 1) & BaseBin
Next
Next
Hex2Bin = BaseBin
Exit Function
ErrHandler:
'Handle error here
Resume Next
End Function
'----------------------------------------------------------END----------------------------------------------------------
You should be able to drop it into a module without any problems. Let me know if this helps.![[spin]](/data/assets/smilies/spin.gif "[spin] [spin]")
If you choose to battle wits with the witless be prepared to lose.
![[machinegun]](/data/assets/smilies/machinegun.gif "[machinegun] [machinegun]")
![[hammer]](/data/assets/smilies/hammer.gif "[hammer] [hammer]")
Enum base
Bin = 2
Oct = 8
Dec = 10
Hex = 16
End Enum
'-----------------------------------------------------------------------------------------------------------------------
'---------------------------------------------------------START---------------------------------------------------------
Function Dec2Any(ByVal number As Long, ByVal base As base) As String
Dim index As Long
Dim Digits As String
Dim digitValue As Long
On Error GoTo ErrHandler
If base < 2 Or base > 36 Then Err.Raise 5
If number = 0 Then
Dec2Any = "0"
Exit Function
End If
Digits = Left("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ", base)
Do While number
digitValue = number Mod base
number = number \ base
Dec2Any = Mid$(Digits, digitValue + 1, 1) & Dec2Any
Loop
Exit Function
ErrHandler:
'Handle error here
Resume Next
End Function
'----------------------------------------------------------END----------------------------------------------------------
'---------------------------------------------------------START---------------------------------------------------------
Function Any2Dec(ByVal NumberBaseX As String, ByVal base As base) As Long
Dim index As Long
Dim Digits As String
Dim digitValue As Long
On Error GoTo ErrHandler
If base < 2 Or base > 36 Then Err.Raise 5
Digits = Left("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ", base)
For index = 1 To Len(NumberBaseX)
digitValue = InStr(1, Digits, Mid$(NumberBaseX, index, 1), vbTextCompare) - 1
If digitValue < 0 Then Err.Raise 5
Any2Dec = Any2Dec * base + digitValue
Next
Exit Function
ErrHandler:
'Handle error here
Resume Next
End Function
'----------------------------------------------------------END----------------------------------------------------------
'Note: This Function Divides the Binary Number into 4 bit digits to prevent Overflow Error. This
'Allows any Binary Number to be converted with out length restictions. Requires Dec2Any Function
'from Above.
'---------------------------------------------------------START---------------------------------------------------------
Function Bin2Hex(ByVal BinaryNumber As String) As String
Dim index As Integer
Dim Bit As Integer
Dim Digits As Integer
Dim Base10 As Long
Dim BaseHex As String
Dim digit As String
Bit = 0
Base10 = 0
BaseHex = ""
Digits = 0
On Error GoTo ErrHandler
Digits = Len(BinaryNumber) \ 4
If Len(BinaryNumber) Mod 4 <> 0 Then
Digits = Digits + 1
End If
For index = Len(BinaryNumber) To 1 Step -1
digit = Mid$(BinaryNumber, index, 1)
Select Case digit
Case "1"
Base10 = (2 ^ Bit) + Base10
Case "0"
'do nothing
Case Else
Err.Raise 5, , "Number to be Converted is not a Binary Number"
End Select
Bit = Bit + 1
If Bit = 4 Then 'Calculate Hex Value for a single digit
BaseHex = Dec2Any(Base10, Hex) & BaseHex
Bit = 0
Base10 = 0
Digits = Digits - 1
End If
Next
If Digits <> 0 Then 'Calculate Hex Value if bits remaining
BaseHex = Dec2Any(Base10, Hex) & BaseHex
End If
Bin2Hex = BaseHex
Exit Function
ErrHandler:
'Handle error here
Resume Next
End Function
'----------------------------------------------------------END----------------------------------------------------------
'Note: This Function Converts Each Digit of the Hexidecimal input String and Converts it into a Four
'Bit Binary Number. This Forces the Return String to to have leading Zeros. There is No limit to the length
'of the Input Hex or Output Binary Number.
'---------------------------------------------------------START---------------------------------------------------------
Function Hex2Bin(ByVal HexNumber As String) As String
Dim index As Integer
Dim number As Integer
Dim bitValue As Integer
Dim d As Integer
Dim digit As String
Dim BaseBin As String
digit = ""
BaseBin = ""
On Error GoTo ErrHandler
For index = Len(HexNumber) To 1 Step -1
digit = Mid$(HexNumber, index, 1)
Select Case digit
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
number = CInt(digit)
Case "A", "a"
number = 10
Case "B", "b"
number = 11
Case "C", "c"
number = 12
Case "D", "d"
number = 13
Case "E", "e"
number = 14
Case "F", "f"
number = 15
Case Else
Err.Raise 5, , "Number to be Converted is not Hexidecimal"
End Select
For d = 1 To 4
bitValue = number Mod 2
number = number \ 2
BaseBin = Mid$("01", bitValue + 1, 1) & BaseBin
Next
Next
Hex2Bin = BaseBin
Exit Function
ErrHandler:
'Handle error here
Resume Next
End Function
'----------------------------------------------------------END----------------------------------------------------------
You should be able to drop it into a module without any problems. Let me know if this helps.
If you choose to battle wits with the witless be prepared to lose.- Status
Similar threads
- Locked
- Question