VB Binary Conversion Encyclopedia

' Binary to decimal public Function b2d (vbstr as String) as Long Dim vLen As Integer ' string length Dim vdec As Long ' result Dim VG As Long ' value Dim VI As Long ' bit Dim vtmp As String ' temporary string Dim vN As Long ' median vLen = Len (v BSTR) VG = 1 ' initial weight vdec = 0 ' result initial value b2d = Vdec ' return initial value for VI = VLen to 1 Step-1 vtmp = Mid (Vbstr, VI , 1) ' remove current bit vn = Val (vtmp) if VN < 2 Then ' judgment is not a legitimate binary string, seemingly not rigorous, e-text and symbols will be sentenced to 0 and legal Vdec = Vdec + VG             * vN ' get intermediate result VG = VG + VG Else vdec = 0 ' MsgBox "is not a valid binary number", vbOKOnly     Exit function End If Next vI b2d = vdecend function ' decimal to binary public Function d2b (Dec as Long) as String D2B = "" Do While Dec > 0 d2b = Dec Mod 2 & d2b dec = Dec \ 2 loopend function ' use: Convert hex Binary ' input: Hex (hexadecimal number) ' Input data type: String ' output: H2B (binary number) ' Output data type: String ' The maximum number entered is 2,147,483,647 characters public Function H2B (ByVal hex as String) as String Dim IAs Long Dim b as String hex = UCase (hex) For i = 1 to Len (hex) Select case Mid (Hex, I, 1)             Case ' 0 ': b = b & ' 0000 ' case ' 1 ': b = b & ' 0001 ' case ' 2 ': b = B & ' 0010 '             Case ' 3 ': b = B & ' 0011 ' case ' 4 ': b = B & ' 0100 ' case ' 5 ': b = B & ' 0101 '             Case ' 6 ': b = B & ' 0110 ' case ' 7 ': b = B & ' 0111 ' case ' 8 ': b = B & ' 1000 '             Case ' 9 ': b = B & ' 1001 ' Case ' A ': b = B & ' 1010 ' case ' B ': b = B & ' 1011 '             Case ' C ': b = B & ' 1100 ' case ' D ': b = B & ' 1101 ' case ' E ': b = B & ' 1110 ' Case "F": b = B & "1111" End select Next I and left (b, 1) = "0" B = right (b, Len (b) -1) Wend H2B = bEnd function ' use: convert binary to hexadecimal ' input: Bin (binary number) ' Input data type: String ' output: b2h (hexadecimal number) ' Output data type: String ' The maximum number entered is 2 147,483,647 characters Public functIon b2h (ByVal Bin As String) As String Dim i as Long Dim H As String If Len (Bin) Mod 4 <> 0 Then Bin = String (4-len (BIN) Mod 4, "0") & Bin End If for me = 1 to Len (BIN) Step 4 Select case Mid (Bi N, I, 4) case "0000": H = h & "0" Case "0001": H = h & "1" Case "0010": H = h  & "2" Case ' 0011 ': H = h & ' 3 ' case ' 0100 ': H = h & ' 4 ' case ' 0101 ': h = h & "5" Case "0110": H = h & "6" Case "0111": H = h & "7" Case "" ": H =  H & "8" Case "1001": H = h & ' 9 ' case ' 1010 ': H = h & ' A ' case ' 1011 ': h = H & "B" Case "1100": H = h & ' C ' case ' 1101 ': H = h & "D" Case "1110": H = h & "E" Case "1111": H = h & "F" End select Next I and Left (h, 1) = "0" h  = Right (H, Len (h)-1)   Wend b2h = HEnd function ' Purpose: convert hex to decimal ' input: Hex (hexadecimal number) ' Input data type: String ' output: h2d (decimal number) ' Output data type: Long ' input maximum number is 7FFFFFFF, The maximum number of outputs is 2147483647Public Function h2d (ByVal hex as String) As Long dim i As Long Dim b As Long Hex = UCase (H  ex) for i = 1 to Len (hex) Select Case Mid (hex, Len (hex)-i + 1, 1) case "0": B = b + ^ (i-1)  * 0 Case ' 1 ': b = b + + ^ (i-1) * 1 case "2": b = b + ^ (i-1) * 2 case "3": b             = B + ^ (i-1) * 3 case "4": b = b + ^ (i-1) * 4 Case "5": b = b + ^ (i-1) * 5  Case "6": B = b + ^ (i-1) * 6 case "7": b = b + ^ (i-1) * 7 Case "8": b = B + 16             ^ (i-1) * 8 case ' 9 ': b = b + ^ (i-1) * 9 case "A": b = b + ^ (i-1) * 10 Case "B": b = b + ^ (i-1) * One case "C": b = b + ^ (i-1) * The case "D": b = b + ^ (i -1) * CaSe "E": b = b + ^ (i-1) * case "F": b = b + ^ (i-1) * End Select Next I h2d = bEnd function ' Purpose: convert decimal to hexadecimal ' input: Dec (decimal number) ' Input data type: Long ' output: d2h (hexadecimal number) ' Output data type: String ' The maximum number entered is 2147483647,         Output maximum number is 7FFFFFFFPublic Function d2h (Dec as Long) As String Dim A As String d2h = "" Do While Dec > 0 A = CSTR (Dec Mod) Select Case a case "ten": A = "a" case "one": A = "B" case "B": a = "C" case ": a =" D "case": a = "E" Case "": A = "F" End Sel ECT d2h = A & d2h Dec = Dec \ loopend function ' Purpose: convert decimal to octal ' Input: Dec (decimal number) ' Input data type: Long ' output: D2 O (octal) ' Output data type: string ' input maximum number is 2147483647, output maximum number is 17777777777Public Function d2o (Dec as Long) as String D2O = "" Do While Dec > 0 d2o = Dec Mod 8 & d2o dec = Dec \ 8 loopend function ' Purpose: convert octal to decimal ' input: Oct (octal number) ' Input data type: String ' output: o2d (decimal number) ' Output data type: LoThe maximum number of NG ' inputs is 17777777777, the maximum number of outputs is 2147483647Public Function o2d (ByVal Oct as String) As Long dim i As Long Dim B as Lo ng for i = 1 to Len (Oct) Select Case Mid (Oct, Len (Oct)-i + 1, 1) case "0": B = B + 8 ^ (i-1 * 0 Case ' 1 ': b = B + 8 ^ (i-1) * 1 case ' 2 ': b = B + 8 ^ (i-1) * 2 case "3": b             = B + 8 ^ (i-1) * 3 case "4": b = B + 8 ^ (i-1) * 4 Case "5": b = B + 8 ^ (i-1) * 5 Case ' 6 ': b = B + 8 ^ (i-1) * 6 case "7": B = B + 8 ^ (i-1) * 7 End Select Next i o2d = BEnd function ' use: Convert binary to octal ' input: Bin (binary number) ' Input data type: String ' output: B2o (octal number) ' Output data type: String ' The maximum number entered is 2,147,483,647 characters public         Function B2o (ByVal Bin As String) As String Dim i as Long Dim H As String If Len (Bin) Mod 3 <> 0 Then Bin = String (3-len (BIN) Mod 3, "0") & Bin End If for me = 1 to Len (BIN) Step 3 Select case M ID (Bin, I, 3) CasE "$": H = h & "0" Case "001": H = h & ' 1 ' case ' 010 ': h = h & ' 2 ' case "011": H = H & "3" Case "+": H = H & "4" Case "101": H = h & "5" case "1         ": H = h &" 6 "Case" 111 ": H = h &" 7 "End select Next I and left (H, 1) =" 0 " H = Right (H, Len (h)-1) wend B2o = HEnd function ' Purpose: convert octal to binary ' input: Oct (octal number) ' Input data type: String ' output: o2b (binary number) ' loss         Out data type: string ' input maximum number is 2,147,483,647 characters public Function o2b (ByVal Oct As String) As String Dim i As Long Dim B As String For i = 1 to Len (Oct) Select Case Mid (Oct, I, 1) case "0": B = B & "$" case ' 1 ': b = B & ' 001 ' case ' 2 ': b = b & ' 010 ' case ' 3 ': b = B & ' 011 ' case ' 4  ": B = B &" Case "5": B = B & "101" Case "6": B = B & "Max" case "7":      B = B & "111"   End Select Next I while left (b, 1) = "0" B = right (b, Len (b)-1) wend o2b = bEnd function ' use: Convert octal to hexadecimal ' input: Oct (octal number) ' Input data type: String ' output: O2H (hexadecimal number) ' Output data type: String ' The maximum number entered is 2,147,483,647 characters public Function O2H (ByVal Oct As String) As String Dim Bin As String bin = o2b (Oct) o2h = b2h (Bin) End Function ' Purpose: convert hex to octal ' Input: Hex (10      Hex number) ' Input data type: String ' output: H2O (octal) ' Output data type: String ' The maximum number entered is 2,147,483,647 characters public Function H2O (ByVal Hex As String) as String Dim bin as String Hex = UCase (hex) bin = H2B (hex) H2O = B2O (Bin) End Function ' ============================ ======================== ' 16 binary ascfunction H2A (Inputdata As String) As String Dim mydata MyData = Chr (Val ("&h" & Inputdata)) H2A = MyData Exit functionend function ' 10 binary long integer to 4 bit 16 binary string Function S2H (Num as Long) as StringDim mynum as Stri  Ngmynum = Hex (Num) If Len (mynum) = 1 Then Mynum = "$" + mynumif len (mynum) = 2 Then Mynum = "xx" + mynumif Len (mynum) = 3 Then Mynum = "0" + Left (mynuM, 2) + right (mynum, 1) If Len (mynum) = 4 Then Mynum = Right (Mynum, 2) + Left (Mynum, 2) s2h = mynumend Function ' 10 binary long integer goto 2 bit 16  Binary string function s2h2 (num as Long) as StringDim mynum as Stringmynum = Hex (Num) If Len (mynum) = 1 Then Mynum = "0" + mynums2h2 = Mynumend function ' ASCII string to 16 binary string public Function a2h (str as String) as StringDim strlen as Integerdim i as Integerdim MyStr as Stringmystr = "" "strlen = Len (str) For i = 1 to strlen Step 1mystr = mystr + hex$ (ASC (Mid (str, I, 1))) Next ia2h = m Ystrend Function ' ===================================================== ' binary inversion ' ===================================     ================== ' anti 16 binary number to 10 binary, total 8-bit function fhextoint (ByVal str As String) As String Dim Text1 As String text1 = str Dim Text2 As String Text2 = Mid (Text1, 7, 2) Dim text3 As String Text3 = Mid (Text1, 5, 2) Dim text4 As Str  ing Text4 = Mid (Text1, 3, 2) Dim text5 as String Text5 = Mid (Text1, 1, 2) Fhextoint = Val ("&h" & Text2 & Text3 & Text4 & Text5) Exit functionend function ' counter 16 binary number to 10 binary, total 6-bit function FHexToInt6 (ByVal str As String) As String Dim Text1 as String Text1 = str Dim text2 As String Text2 = Mid (Text1, 5, 2) Dim Text4 As String Text3 = Mid (Text1, 3, 2) Di M TEXT5 as String Text4 = Mid (Text1, 1, 2) FHexToInt6 = Val ("&h" & Text2 & Text3 & Text4) Exit Fu nctionend function ' Anti 16 binary number to 10 binary, total 4-bit Function FHexToInt4 (ByVal str As String) As String Dim Text1 As String text1 = St R Dim Text2 As String Text2 = Mid (Text1, 3, 2) Dim Text4 As String text3 = Mid (Text1, 1, 2) FHexToInt4 = Va  L ("&h" & Text2 & Text3) Exit functionend function ' 10 binary number to 16 binary, total 8-bit Function Inttofhex (ByVal nums as Long) as String Dim Text1 as String ' Text1 = convert.tostring (Nums, &h10) Text1 = O2H (nums) If (Len (Text1) = 1) Th En Text1 = ("0000000" & Text1) End If if (Len (Text1) = 2) Then Text1 = ("000000" & Text1) E nd if if (Len (Text1)= 3) Then Text1 = ("00000" & Text1) End If if (Len (Text1) = 4) Then Text1 = ("0000" & Text1)  End If if (len (Text1) = 5) Then Text1 = ("& Text1") End If if (len (Text1) = 6) Then Text1 = ("xx" & Text1) End If if (Len (Text1) = 7) Then Text1 = ("0" & Text1) End If Dim Text2 as Str ing Text2 = Mid (Text1, 7, 2) Dim text3 As String Text3 = Mid (Text1, 5, 2) Dim Text4 As String Text4 = Mid (t    Ext1, 3, 2) Dim text5 as String text5 = Mid (Text1, 1, 2) Inttofhex = Text2 & Text3 & Text4 & TEXT5 Exit functionend function ' 10 binary number to 16 binary number, total 6-bit function IntToFHex6 (ByVal nums as Long) As String Dim Text1 as String Tex        T1 = O2H (nums) if (len (Text1) = 1) Then Text1 = ("00000" & Text1) End if if (len (Text1) = 2) Then Text1 = ("0000" & Text1) End If if (Len (Text1) = 3) Then Text1 = ("" & Text1) End If if (    Len (Text1) = 4) Then    Text1 = ("xx" & Text1) End If if (Len (Text1) = 5) Then Text1 = ("0" & Text1) End If Dim Tex T2 As String text2 = Mid (Text1, 5, 2) Dim text3 As String Text3 = Mid (Text1, 3, 2) Dim Text4 As String text 4 = Mid (Text1, 1, 2) IntToFHex6 = Text2 & Text3 & Text4 Exit functionend function ' 10 binary number turn 16 binary, total 4-bit Function I NTTOFHEX4 (ByVal nums as Long) As String Dim Text1 As String Text1 = O2H (nums) If (Len (Text1) = 1) then Tex T1 = ("& Text1") End If If (len (Text1) = 2) Then Text1 = ("xx" & Text1) End If if (Len (text  1) = 3) Then Text1 = ("0" & Text1) End If Dim text2 As String Text2 = Mid (Text1, 3, 2) Dim Text3 as String Text3 = Mid (Text1, 1, 2) IntToFHex4 = text2 & text3 Exit functionend Function ' ======================= ===================public Function b2s (ByVal str as Byte) Strto = "" For i = 1 to LenB (str) If AscB (MidB (str,    I, 1)) > 127 Then       Strto = Strto & Chr (AscB (MidB (str, I, 1)) * + AscB (MidB (str, i + 1, 1))) i = i + 1 Else Strto = Strto & Chr (AscB (MidB (str, I, 1))) End If Next b2s = strtoend functionpublic Function v2h (B Yval ShEx as String, Optional Bunicode as Boolean) Dim sByte As Variant Dim Bychar () As Byte Dim i as Long sHe x = Replace (ShEx, VbCrLf, "") SByte = Split (ShEx, "") ReDim Bychar (0 to UBound (sByte)) as Byte for i = 0 to Ubou nd (sByte) bychar (i) = Val ("&h" & SByte (i)) Next If bunicode then v2h = Bychar Else V              2H = StrConv (Bychar, vbunicode) End ifend function ' recordset goto binary Stream Public Function r2b (rs as Recordset) as Variant    ' Recordset converted to binary data Dim objstream as Stream Set objstream = New Stream objStream.Open objstream.type = adTypeBinary Rs. Save objstream, ADPERSISTADTG objstream.position = 0 r2b = objstream.read () Set objstream = NothingEnd Function ' A SCII transcoding binary Stream public FUnction a2b (str as String) as Variant Dim A () as Byte, s as string s = str a = StrConv (S, vbFromUnicode) ' string converted to byte   Type ' A is a byte array that you can call in your program, but not in a textbox. A2B = aend function ' binary flow ASCII public Function b2a (VData as Variant) As String Dim s As String s = StrConv (VData, Vbun icode) ' byte type converted to string b2a = SEnd Function

　　

VB Binary Conversion Encyclopedia