首页 > 代码库 > VB 进制转换大全

VB 进制转换大全

‘二进制转十进制Public Function B2D(vBStr As String) As Long     Dim vLen As Integer  ‘串长     Dim vDec As Long     ‘结果     Dim vG As Long       ‘权值     Dim vI As Long       ‘位数     Dim vTmp As String   ‘临时串     Dim vN As Long       ‘中间值    vLen = Len(vBStr)    vG = 1 ‘初始权值     vDec = 0   ‘结果初值     B2D = vDec ‘返回初值    For vI = vLen To 1 Step -1         vTmp = Mid(vBStr, vI, 1) ‘取出当前位         vN = Val(vTmp)        If vN < 2 Then  ‘判断是不是合法二进制串,貌似不严谨,E文和符号会被判0而合法             vDec = vDec + vG * vN ‘得到中间结果             vG = vG + vG         Else             vDec = 0             ‘msgbox "不是有效的二进制数",vbokonly             Exit Function         End If    Next vI    B2D = vDecEnd Function‘十进制转二进制Public Function D2B(Dec As Long) As String     D2B = ""     Do While Dec > 0         D2B = Dec Mod 2 & D2B         Dec = Dec \ 2     LoopEnd Function‘ 用途:将十六进制转化为二进制‘ 输入:Hex(十六进制数)‘ 输入数据类型:String‘ 输出:H2B(二进制数)‘ 输出数据类型:String‘ 输入的最大数为2147483647个字符Public Function H2B(ByVal Hex As String) As String     Dim i As 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     While Left(b, 1) = "0"         b = Right(b, Len(b) - 1)     Wend     H2B = bEnd Function‘ 用途:将二进制转化为十六进制‘ 输入:Bin(二进制数)‘ 输入数据类型:String‘ 输出:B2H(十六进制数)‘ 输出数据类型:String‘ 输入的最大数为2147483647个字符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 i = 1 To Len(Bin) Step 4         Select Case Mid(Bin, 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 "1000": 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     While Left(H, 1) = "0"         H = Right(H, Len(H) - 1)     Wend     B2H = HEnd Function‘ 用途:将十六进制转化为十进制‘ 输入:Hex(十六进制数)‘ 输入数据类型:String‘ 输出:H2D(十进制数)‘ 输出数据类型:Long‘ 输入的最大数为7FFFFFFF,输出的最大数为2147483647Public Function H2D(ByVal Hex As String) As Long     Dim i As Long     Dim b As Long        Hex = UCase(Hex)     For i = 1 To Len(Hex)         Select Case Mid(Hex, Len(Hex) - i + 1, 1)             Case "0": b = b + 16 ^ (i - 1) * 0             Case "1": b = b + 16 ^ (i - 1) * 1             Case "2": b = b + 16 ^ (i - 1) * 2             Case "3": b = b + 16 ^ (i - 1) * 3             Case "4": b = b + 16 ^ (i - 1) * 4             Case "5": b = b + 16 ^ (i - 1) * 5             Case "6": b = b + 16 ^ (i - 1) * 6             Case "7": b = b + 16 ^ (i - 1) * 7             Case "8": b = b + 16 ^ (i - 1) * 8             Case "9": b = b + 16 ^ (i - 1) * 9             Case "A": b = b + 16 ^ (i - 1) * 10             Case "B": b = b + 16 ^ (i - 1) * 11             Case "C": b = b + 16 ^ (i - 1) * 12             Case "D": b = b + 16 ^ (i - 1) * 13             Case "E": b = b + 16 ^ (i - 1) * 14             Case "F": b = b + 16 ^ (i - 1) * 15         End Select     Next i     H2D = bEnd Function‘ 用途:将十进制转化为十六进制‘ 输入:Dec(十进制数)‘ 输入数据类型:Long‘ 输出:D2H(十六进制数)‘ 输出数据类型:String‘ 输入的最大数为2147483647,输出最大数为7FFFFFFFPublic Function D2H(Dec As Long) As String     Dim a As String     D2H = ""     Do While Dec > 0         a = CStr(Dec Mod 16)         Select Case a             Case "10": a = "A"             Case "11": a = "B"             Case "12": a = "C"             Case "13": a = "D"             Case "14": a = "E"             Case "15": a = "F"         End Select         D2H = a & D2H         Dec = Dec \ 16     LoopEnd Function‘ 用途:将十进制转化为八进制‘ 输入:Dec(十进制数)‘ 输入数据类型:Long‘ 输出:D2O(八进制数)‘ 输出数据类型:String‘ 输入的最大数为2147483647,输出最大数为17777777777Public Function D2O(Dec As Long) As String     D2O = ""     Do While Dec > 0         D2O = Dec Mod 8 & D2O         Dec = Dec \ 8     LoopEnd Function‘ 用途:将八进制转化为十进制‘ 输入:Oct(八进制数)‘ 输入数据类型:String‘ 输出:O2D(十进制数)‘ 输出数据类型:Long‘ 输入的最大数为17777777777,输出的最大数为2147483647Public Function O2D(ByVal Oct As String) As Long     Dim i As Long     Dim b As Long        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‘ 用途:将二进制转化为八进制‘ 输入:Bin(二进制数)‘ 输入数据类型:String‘ 输出:B2O(八进制数)‘ 输出数据类型:String‘ 输入的最大数为2147483647个字符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 i = 1 To Len(Bin) Step 3         Select Case Mid(Bin, i, 3)             Case "000": H = H & "0"             Case "001": H = H & "1"             Case "010": H = H & "2"             Case "011": H = H & "3"             Case "100": H = H & "4"             Case "101": H = H & "5"             Case "110": H = H & "6"             Case "111": H = H & "7"         End Select     Next i     While Left(H, 1) = "0"         H = Right(H, Len(H) - 1)     Wend     B2O = HEnd Function‘ 用途:将八进制转化为二进制‘ 输入:Oct(八进制数)‘ 输入数据类型:String‘ 输出:O2B(二进制数)‘ 输出数据类型:String‘ 输入的最大数为2147483647个字符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 & "000"             Case "1": b = b & "001"             Case "2": b = b & "010"             Case "3": b = b & "011"             Case "4": b = b & "100"             Case "5": b = b & "101"             Case "6": b = b & "110"             Case "7": b = b & "111"         End Select     Next i     While Left(b, 1) = "0"         b = Right(b, Len(b) - 1)     Wend     O2B = bEnd Function‘ 用途:将八进制转化为十六进制‘ 输入:Oct(八进制数)‘ 输入数据类型:String‘ 输出:O2H(十六进制数)‘ 输出数据类型:String‘ 输入的最大数为2147483647个字符Public Function O2H(ByVal Oct As String) As String     Dim Bin As String     Bin = O2B(Oct)     O2H = B2H(Bin)End Function‘ 用途:将十六进制转化为八进制‘ 输入:Hex(十六进制数)‘ 输入数据类型:String‘ 输出:H2O(八进制数)‘ 输出数据类型:String‘ 输入的最大数为2147483647个字符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进制转ASCFunction H2A(InputData As String) As String  Dim mydata  mydata = http://www.mamicode.com/Chr(Val("&H" & InputData))  H2A = mydata  Exit FunctionEnd Function‘10进制长整数转4位16进制字符串Function S2H(Num As Long) As StringDim mynum As Stringmynum = Hex(Num)If Len(mynum) = 1 Then mynum = "000" + mynumIf Len(mynum) = 2 Then mynum = "00" + 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进制长整数转2位16进制字符串Function S2H2(Num As Long) As StringDim mynum As Stringmynum = Hex(Num)If Len(mynum) = 1 Then mynum = "0" + mynumS2H2 = mynumEnd Function‘ASCII字符串转16进制字符串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 = mystrEnd Function‘=====================================================‘进制反转‘=====================================================‘反16进制数转10进制数,共8位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 String    text4 = Mid(text1, 3, 2)    Dim text5 As String    text5 = Mid(text1, 1, 2)    FHexToInt = Val("&H" & text2 & text3 & text4 & text5)    Exit FunctionEnd Function‘反16进制数转10进制数,共6位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)    Dim text5 As String    text4 = Mid(text1, 1, 2)    FHexToInt6 = Val("&H" & text2 & text3 & text4)    Exit FunctionEnd Function‘反16进制数转10进制数,共4位Function FHexToInt4(ByVal str As String) As String    Dim text1 As String    text1 = str    Dim text2 As String    text2 = Mid(text1, 3, 2)    Dim text4 As String    text3 = Mid(text1, 1, 2)    FHexToInt4 = Val("&H" & text2 & text3)    Exit FunctionEnd Function‘10进制数转反16进制数,共8位Function IntToFHex(ByVal nums As Long) As String    Dim text1 As String    ‘text1 = Convert.ToString(nums, &H10)    text1 = O2H(nums)    If (Len(text1) = 1) Then        text1 = ("0000000" & text1)    End If    If (Len(text1) = 2) Then        text1 = ("000000" & text1)    End 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 = ("000" & text1)    End If    If (Len(text1) = 6) Then        text1 = ("00" & text1)    End If    If (Len(text1) = 7) Then        text1 = ("0" & text1)    End If    Dim text2 As String    text2 = Mid(text1, 7, 2)    Dim text3 As String    text3 = Mid(text1, 5, 2)    Dim text4 As String    text4 = Mid(text1, 3, 2)    Dim text5 As String    text5 = Mid(text1, 1, 2)    IntToFHex = text2 & text3 & text4 & text5    Exit FunctionEnd Function‘10进制数转反16进制数,共6位Function IntToFHex6(ByVal nums As Long) As String    Dim text1 As String    text1 = 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 = ("000" & text1)    End If    If (Len(text1) = 4) Then        text1 = ("00" & text1)    End If    If (Len(text1) = 5) Then        text1 = ("0" & text1)    End If    Dim text2 As String    text2 = Mid(text1, 5, 2)    Dim text3 As String    text3 = Mid(text1, 3, 2)    Dim text4 As String    text4 = Mid(text1, 1, 2)    IntToFHex6 = text2 & text3 & text4    Exit FunctionEnd Function‘10进制数转反16进制数,共4位Function IntToFHex4(ByVal nums As Long) As String    Dim text1 As String    text1 = O2H(nums)    If (Len(text1) = 1) Then        text1 = ("000" & text1)    End If    If (Len(text1) = 2) Then        text1 = ("00" & text1)    End If    If (Len(text1) = 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)) * 256 + 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(ByVal sHex As String, Optional bUnicode As Boolean)    Dim sByte As Variant    Dim byChar() As Byte    Dim i As Long    sHex = Replace(sHex, vbCrLf, "")    sByte = Split(sHex, " ")    ReDim byChar(0 To UBound(sByte)) As Byte    For i = 0 To UBound(sByte)        byChar(i) = Val("&h" & sByte(i))    Next    If bUnicode Then        V2H = byChar    Else        V2H = StrConv(byChar, vbUnicode)    End IfEnd Function‘记录集转二进制流Public Function R2B(rs As Recordset) As Variant              ‘记录集转换为二进制数据    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‘ASCII码转二进制流Public Function A2B(str As String) As Variant   Dim a() As Byte, s As String   s = str   a = StrConv(s, vbFromUnicode) ‘字符串转换为byte型 ‘a 是byte数组,你可以在程序中调用 ,但不能在textbox中显示。   A2B = aEnd Function‘二进制流转ASCII码Public Function B2A(vData As Variant) As String   Dim s As String   s = StrConv(vData, vbUnicode) ‘byte型转换为字符串   B2A = sEnd Function

  

VB 进制转换大全