Visual Basic Programming Code Examples

Binary Conversions 'The Functions in this module are designed to aid in working with BINARY 'numbers. Visual Basic does not include nor allow any representation of a 'number in binary format. Therefore, all of these functions work strictly on 'strings. All of the parameters passed into them and returned from them are 'strings. ' ' CONVERSION NEEDED FUNCTION ' ------------------------------------------------------ ' Binary to Hex BinToHex(BinNum As String) ' Binary to Octal BinToOct(BinNum As String) ' Binary to Decimal BinToDec(BinNum As String) ' Hex to Binary HexToBin(HexNum As String) ' Octal to Binary OctToBin(OctNum As String) ' Decimal to Binary DecToBin(DecNum As String) ' ' Option Explicit Function BinToHex(BinNum As String) As String Dim BinLen As Integer, i As Integer Dim HexNum As Variant On Error GoTo ErrorHandler BinLen = Len(BinNum) For i = BinLen To 1 Step -1 ' Check the string for invalid characters If Asc(Mid(BinNum, i, 1)) < 48 Or _ Asc(Mid(BinNum, i, 1)) > 49 Then HexNum = "" Err.Raise 1002, "BinToHex", "Invalid Input" End If ' Calculate HEX value of BinNum If Mid(BinNum, i, 1) And 1 Then HexNum = HexNum + 2 ^ Abs(i - BinLen) End If Next i ' Return HexNum as String BinToHex = Hex(HexNum) ErrorHandler: End Function Function BinToOct(BinNum As String) As String Dim BinLen As Integer, i As Integer Dim OctNum As Variant On Error GoTo ErrorHandler BinLen = Len(BinNum) For i = BinLen To 1 Step -1 ' Check the string for invalid characters If Asc(Mid(BinNum, i, 1)) < 48 Or _ Asc(Mid(BinNum, i, 1)) > 49 Then OctNum = "" Err.Raise 1002, "BinToOct", "Invalid Input" End If ' Calculate Octal value of BinNum If Mid(BinNum, i, 1) And 1 Then OctNum = OctNum + 2 ^ Abs(i - BinLen) End If Next i ' Return OctNum as String BinToOct = Oct(OctNum) ErrorHandler: End Function Public Function BinToDec(BinNum As String) As String Dim i As Integer Dim DecNum As Long On Error GoTo ErrorHandler ' Loop thru BinString For i = Len(BinNum) To 1 Step -1 ' Check the string for invalid characters If Asc(Mid(BinNum, i, 1)) < 48 Or _ Asc(Mid(BinNum, i, 1)) > 49 Then DecNum = "" Err.Raise 1002, "BinToDec", "Invalid Input" End If ' If bit is 1 then raise 2^LoopCount and add it to DecNum If Mid(BinNum, i, 1) And 1 Then DecNum = DecNum + 2 ^ (Len(BinNum) - i) End If Next i ' Return DecNum as a String BinToDec = DecNum ErrorHandler: End Function Public Function OctToBin(OctNum As String) As String Dim BinNum As String Dim lOctNum As Long Dim i As Integer On Error GoTo ErrorHandler ' Check the string for invalid characters For i = 1 To Len(OctNum) If (Asc(Mid(OctNum, i, 1)) < 48 Or Asc(Mid(OctNum, i, 1)) > 55) Then BinNum = "" Err.Raise 1008, "OctToBin", "Invalid Input" End If Next i i = 0 lOctNum = Val("&O" & OctNum) Do If lOctNum And 2 ^ i Then BinNum = "1" & BinNum Else BinNum = "0" & BinNum End If i = i + 1 Loop Until 2 ^ i > lOctNum ' Return BinNum as a String OctToBin = BinNum ErrorHandler: End Function Public Function DecToBin(DecNum As String) As String Dim BinNum As String Dim lDecNum As Long Dim i As Integer On Error GoTo ErrorHandler ' Check the string for invalid characters For i = 1 To Len(DecNum) If Asc(Mid(DecNum, i, 1)) < 48 Or _ Asc(Mid(DecNum, i, 1)) > 57 Then BinNum = "" Err.Raise 1010, "DecToBin", "Invalid Input" End If Next i i = 0 lDecNum = Val(DecNum) Do If lDecNum And 2 ^ i Then BinNum = "1" & BinNum Else BinNum = "0" & BinNum End If i = i + 1 Loop Until 2 ^ i > lDecNum ' Return BinNum as a String DecToBin = BinNum ErrorHandler: End Function Public Function HexToBin(HexNum As String) As String Dim BinNum As String Dim lHexNum As Long Dim i As Integer On Error GoTo ErrorHandler ' Check the string for invalid characters For i = 1 To Len(HexNum) If ((Asc(Mid(HexNum, i, 1)) < 48) Or _ (Asc(Mid(HexNum, i, 1)) > 57 And _ Asc(UCase(Mid(HexNum, i, 1))) < 65) Or _ (Asc(UCase(Mid(HexNum, i, 1))) > 70)) Then BinNum = "" Err.Raise 1016, "HexToBin", "Invalid Input" End If Next i i = 0 lHexNum = Val("&h" & HexNum) Do If lHexNum And 2 ^ i Then BinNum = "1" & BinNum Else BinNum = "0" & BinNum End If i = i + 1 Loop Until 2 ^ i > lHexNum ' Return BinNum as a String HexToBin = BinNum ErrorHandler: End Function