VBS 进制相互转换

最新推荐文章于 2024-08-30 17:15:57 发布

永远是我的最爱

最新推荐文章于 2024-08-30 17:15:57 发布

阅读量4.4k

点赞数

分类专栏： SCADA DIAView 文章标签： DIAView Delta 组态 WPF SCADA

本文链接：https://blog.csdn.net/qq_40191093/article/details/84759834

版权

SCADA DIAView 专栏收录该内容

37 篇文章 3 订阅

订阅专栏

效果动画演示

实现步骤

步骤一：创建窗口，并设计窗口画面

步骤二：按钮 “十进制==>二进制”事件

Dec=Trim(文本框0.Text)

D2B = ""
Do While Dec > 0
D2B = Dec Mod 2 & D2B
Dec = Dec \ 2
Loop
lblerjinzhi.Text=D2B

步骤三：按钮“十进制==>十六进制”事件

Dec=Trim(文本框0.Text)

Dim a
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
Loop
lblshiliujinzhi.Text=D2H

步骤四：按钮“十六进制==>十进制”事件

HexStr=Trim(文本框0.Text)

Dim i,b

HexStr = UCase(HexStr)
For i = 1 To Len(HexStr)
    Select Case Mid(HexStr, Len(HexStr) - 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 
H2D = b
lblshiliutoshi.Text=H2D

VBS 脚本常用的进制转换函数

    '二进制转十进制
    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 = CInt(vTmp)

            If vN < 2 Then  '判断是不是合法二进制串,貌似不严谨,E文和符号会被判0而合法
                 vDec = vDec + vG * vN '得到中间结果
                 vG = vG + vG
             Else
                 vDec = 0
                 'msgbox "不是有效的二进制数",vbokonly
                 Exit Function
             End If
        Next

        B2D = vDec
    End Function

    '十进制转二进制
    Public Function D2B(Dec As Long) As String
         D2B = ""
         Do While Dec > 0
             D2B = Dec Mod 2 & D2B
             Dec = Dec \ 2
         Loop
    End 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 = b
    End 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 = H
    End Function

    ' 用途：将十六进制转化为十进制
    ' 输入：Hex(十六进制数)
    ' 输入数据类型：String
    ' 输出：H2D(十进制数)
    ' 输出数据类型：Long
    ' 输入的最大数为7FFFFFFF,输出的最大数为2147483647
    Public 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 = b
    End Function

    ' 用途：将十进制转化为十六进制
    ' 输入：Dec(十进制数)
    ' 输入数据类型：Long
    ' 输出：D2H(十六进制数)
    ' 输出数据类型：String
    ' 输入的最大数为2147483647,输出最大数为7FFFFFFF
    Public 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
         Loop
    End Function

    ' 用途：将十进制转化为八进制
    ' 输入：Dec(十进制数)
    ' 输入数据类型：Long
    ' 输出：D2O(八进制数)
    ' 输出数据类型：String
    ' 输入的最大数为2147483647,输出最大数为17777777777
    Public Function D2O(Dec As Long) As String
         D2O = ""
         Do While Dec > 0
             D2O = Dec Mod 8 & D2O
             Dec = Dec \ 8
         Loop
    End Function

    ' 用途：将八进制转化为十进制
    ' 输入：Oct(八进制数)
    ' 输入数据类型：String
    ' 输出：O2D(十进制数)
    ' 输出数据类型：Long
    ' 输入的最大数为17777777777,输出的最大数为2147483647
    Public 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 = b
    End 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 = H
    End 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 = b
    End 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进制转ASC
    Function H2A(InputData As String) As String
      Dim mydata
      mydata = Chr(Val("&H" & InputData))
      H2A = mydata
      Exit Function
    End Function

    '10进制长整数转4位16进制字符串
    Function S2H(Num As Long) As String
    Dim mynum As String
    mynum = Hex(Num)
    If Len(mynum) = 1 Then mynum = "000" + mynum
    If Len(mynum) = 2 Then mynum = "00" + mynum
    If 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 = mynum
    End Function

    '10进制长整数转2位16进制字符串
    Function S2H2(Num As Long) As String
    Dim mynum As String
    mynum = Hex(Num)
    If Len(mynum) = 1 Then mynum = "0" + mynum
    S2H2 = mynum
    End Function

    'ASCII字符串转16进制字符串
    Public Function A2H(str As String) As String
    Dim strlen As Integer
    Dim i As Integer
    Dim mystr As String
    mystr = ""
    strlen = Len(str)
    For i = 1 To strlen Step 1
    mystr = mystr + Hex$(Asc(Mid(str, i, 1)))
    Next i
    A2H = mystr
    End 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 Function
    End 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 Function
    End 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 Function
    End 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 Function
    End 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 Function
    End 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 Function
    End 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 = strto
    End Function

    Public 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 If
    End 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 = Nothing
    End 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 = a
    End Function

    '二进制流转ASCII码

    Public Function B2A(vData As Variant) As String
       Dim s As String
       s = StrConv(vData, vbUnicode) 'byte型转换为字符串
       B2A = s
    End Function