zoukankan      html  css  js  c++  java
  • vb6的一些自己写的函数 用于类型转换,十六进制输出,字节转换

    基本的函数

    '用于将 一个变量 的类型打印出来。
    Public Function getVarTypeToString(ByVal m_value As VbVarType) As String
        'varType typename
    'information: IsArray IsDate IsEmpty IsError IsMissing IsNULL isNumric IsObject
        Select Case m_value
        Case vbArray
            ', vbArray + vbByte, vbArray + vbInteger, vbArray + vbLong, vbArray + vbDouble:
            getVarTypeToString = "vbArray"
        Case vbBoolean
            getVarTypeToString = "vbBoolean"
        Case vbByte
            getVarTypeToString = "vbByte"
        Case vbCurrency
            getVarTypeToString = "vbCurrency"
        Case vbDataObject
            getVarTypeToString = "vbDataObject"
        Case vbDate
            getVarTypeToString = "vbDate"
        Case vbDecimal
            getVarTypeToString = "vbDecimal"
        Case vbDouble
            getVarTypeToString = "vbDouble"
        Case vbEmpty
            getVarTypeToString = "vbEmpty"
        Case vbError
            getVarTypeToString = "vbError"
        Case vbInteger
            getVarTypeToString = "vbInteger"
        Case vbLong
            getVarTypeToString = "vbLong"
        Case vbNull
            getVarTypeToString = "vbNull"
        Case vbObject
            getVarTypeToString = "vbObject"
        Case vbSingle
            getVarTypeToString = "vbSingle"
        Case vbString
            getVarTypeToString = "vbString"
        Case vbUserDefinedType
            getVarTypeToString = "vbUserDefinedType"
        Case vbVariant
            getVarTypeToString = "vbVariant"
        Case Else
            If m_value > 8192 Then
                getVarTypeToString = "vbArray + " & getVarTypeToString(m_value - 8192)
            Else
                getVarTypeToString = CDbl(m_value) & " is what varType ######### (in getVarTypeToString() ) # ? "
            End If
        End Select
        
    End Function

    上面的函数可以将 各种类型的数组都打印出来。

    其各种类型 都对应这一些数字,分别是:

    string相关函数

    Public Function showString(ByVal str As String)
        Dim i
        'myDebug "str = " & str
        For i = 1 To Len(str)
            showString = showString & " " & Mid$(str, i, 1)
        Next
        myDebug showString
    End Function
    
    Public Function string2bytes(ByVal str As String) As Byte()
        Dim mulBits() As Byte
        Dim i
        ReDim Preserve mulBits(Len(str) - 1 )'从0开始的,如果不-1,则会在字节数组后面多出一个0
        For i = 1 To Len(str)
            'ReDim Preserve mulBits(i)
            
            mulBits(i - 1) = Asc(Mid(str, i, 1))
        Next
        'mulBits = str
        'myDebug UBound(mulBits)'string是unicode,所以直接转换会会变成双倍个数 8 =》16
        string2bytes = mulBits
    End Function
    
    Public Function bytes2string(ByRef bytes() As Byte) As String
        Dim str As String
        Dim i
        For i = 0 To UBound(bytes)
            bytes2string = bytes2string & Chr(bytes(i))
        Next
    End Function

    测试函数:

        Dim str1 As String: str1 = "cnblogsCOM"
        showString str1
        myDebug getHex(str1)
        myDebug getHex(string2bytes(str1))
        myDebug getHex(bytes2string(string2bytes(str1)))
        myDebug getHex(string2bytes(bytes2string(string2bytes(str1))))
        myDebug getHex(bytes2string(string2bytes(bytes2string(string2bytes(str1)))))
    结果为:

    ==============================
    c n b l o g s C O M
    [getHex Type is vbString]
    0x 63 6E 62 6C 6F 67 73 43 4F 4D
    [getHex Type is vbArray + vbByte]
    0x 63 6E 62 6C 6F 67 73 43 4F 4D
    [getHex Type is vbString]
    0x 63 6E 62 6C 6F 67 73 43 4F 4D
    [getHex Type is vbArray + vbByte]
    0x 63 6E 62 6C 6F 67 73 43 4F 4D
    [getHex Type is vbString]
    0x 63 6E 62 6C 6F 67 73 43 4F 4D
    ==============================

    字节数组 和 integer long 整数的互相转换

    暂时没有完成。

     应该有 integer2bytes long2bytes

    bytes2integer bytes2long

    四个函数,分别 用 两个字节,四个字节表示 integer和long(vb中integer就是两个字节而已),没有64位的类型。唉 弱弱的vb,与易学的vb真是不兼容啊。

     2字节integer和4字节long与byte()互相转换的函数为:

    '######################################################################################################
    '整数和字节数组 转换
    '######################################################################################################
    Public Function BytesToInt2(ByRef b() As Byte) As Integer
        If UBound(b) < 1 Then
            MsgBox "#Error: in BytesToInt2(byte()),byte() is not 2 bytes!"
        End If
        
        Dim s0 As Integer: s0 = b(0) And &HFF&
        Dim s1 As Integer: s1 = b(1) And &HFF&
        'SHL(s0,0)
        If Not SHL(s1, 8) Then
            MsgBox "#Error to SHL()"
        End If
        BytesToInt2 = s0 Or s1
    End Function
    
    Public Function BytesToInt4(ByRef b() As Byte) As Long
        
        If UBound(b) < 3 Then
            MsgBox "#Error: in BytesToInt2(byte()),byte() is not 4 bytes!"
        End If
        Dim s0 As Long: s0 = b(0) And &HFF
        Dim s1 As Long: s1 = b(1) And &HFF
        Dim s2 As Long: s2 = b(2) And &HFF
        Dim s3 As Long: s3 = b(3) And &HFF
        'MsgBox "Before bitOpt bytestoint4 s0-s1=" & Hex$(s0) & " " & Hex$(s1) & " " & Hex$(s2) & " " & Hex$(s3) & " "
        'SHL(s0,0)
        If Not SHL(s1, 8) Then
            MsgBox "#Error to SHL()"
        End If
        If Not SHL(s2, 16) Then
            MsgBox "#Error to SHL()"
        End If
        If Not SHL(s3, 24) Then
            MsgBox "#Error to SHL()"
        End If
        'MsgBox "After bitopt bytestoint4 s0-s1=" & Hex$(s0) & " " & Hex$(s1) & " " & Hex$(s2) & " " & Hex$(s3) & " "
        BytesToInt4 = s0 Or s1 Or s2 Or s3
    End Function
    
    
    
    Public Function Int2ToBytes(ByVal vData As Integer) As Byte()
        Dim ret() As Byte
        Dim s0 As Integer, s1 As Integer
        s0 = vData And &HFF
        s1 = vData And &HFF00
        If Not SHR(s1, 8) Then
            MsgBox "#ERROR:to SHR() "
        End If
        ReDim ret(1)
        ret(0) = s0
        ret(1) = s1
        Int2ToBytes = ret
    End Function
    
    Public Function Int4ToBytes(ByVal vData As Long) As Byte()
        
        Dim ret() As Byte
        Dim s0 As Long, s1 As Long, s2 As Long, s3 As Long
        s0 = vData And &HFF
        s1 = vData And &HFF00
        If Not SHL(s1, 16) Then
            MsgBox "#ERRO to SHL()"
        End If
        If Not SHR(s1, 16) Then
            MsgBox "#ERRO to SHR()"
        End If
        
        s2 = vData And &HFF0000
        s3 = vData And &HFF000000
        
        'SHR(s0,8*0)
        If Not SHR(s1, 8 * 1) Then
            MsgBox "#ERROR:to SHR() "
        End If
        If Not SHR(s2, 8 * 2) Then
            MsgBox "#ERROR:to SHR() "
        End If
        If Not SHR(s3, 8 * 3) Then
            MsgBox "#ERROR:to SHR() "
        End If
        
        ReDim ret(3)
        ret(0) = s0
        ret(1) = s1
        ret(2) = s2
        ret(3) = s3
        Int4ToBytes = ret
    End Function
    
    
    Public Function BytesToLong(ByRef b() As Byte) As Long
        BytesToLong = BytesToInt4(b)
    End Function
    Public Function LongToBytes(ByVal vData As Long) As Byte()
        LongToBytes = Int4ToBytes(vData)
    End Function

    其依赖与BitPlus.bas

    BitPlus位操作 vb模块代码
    Option Explicit
    
    'Module: BitPlus.Bas
    '发信人:hermit (阿修罗~相拥我爱), 信区: VisualBasic
    '标 题:   VB中位操作运算函数【移位指令】
    '发信站:BBS 水木清华站 (Sat Jun  1 12:40:23 2002)
    'Code By Hermit @ SMTH , Jun. 1st,2000
    'Email: mailtocw@sohu.com
    'May these functions will help you, and
    'Please keep this header if you use my code,thanks!
    
    '提供在VB下进行位运算的函数
    'SHL 逻辑左移  SHR  逻辑右移
    'SAL 算术左移  SAR  算术右移
    'ROL 循环左移  ROR  循环右移
    'RCL 带进位循环左移  RCR  带进位循环右移
    'Bin 将给定的数据转化成2进制字符串
    
    '使用方法
    'SHL SHR SAL SAR ROL ROR 基本类似,以SHL为例说明
    '可以移位的变量类型,字节(Byte),整数(Integer),长整数(Long)
    '返回值 True 移位成功, False 移位失败,当对非上述类型进行移位是会返回False
    'Num 传引用变量,要移位的数据,程序会改写Num的值为运算后结果
    'iCL 传值变量,要移位的次数,缺省值移位1次
    '例 Dim A As Integer
    '   A = &H10
    '如 SHL A    则移位后 A = &H20
    '如 SHL A,2  则移位后 A = &H40
    '如 SHL A,4  则移位后 A = &H00
    'RCR与RCL类似,以RCL为例说明
    '这里需要多给定一个参数,即第一次移位时的进位值iCF
    
    'Bin举例
    'A = &H1
    '如 A 为字节,则 Bin(A) 返回值为 "00000001"
    '如 A 为整数,则 Bin(A) 返回值为 "0000000000000001"
    '如 A 为长整数,则 Bin(A) 返回值为 "00000000000000000000000000000001"
    '如果传入参数非上述类型时,返回值为 ""
    '更详细的信息,请参考相关汇编书籍
    
    Public Function testBitPlus() As String
        Dim testData As Integer
        Dim str As String
        
        testData = &HF000
        str = str & "数据为:" & Bin(testData) & vbCrLf & vbCrLf
        If SHR(testData, 10) Then
            str = str & "SHR,10:" & Bin(testData) & " 逻辑右移" & vbCrLf
        End If
        testData = &HF000
        If SAR(testData, 10) Then
            str = str & "SAR,10:" & Bin(testData) & " 算术右移" & vbCrLf & vbCrLf
        End If
        
        
        testData = &H100
        str = str & "数据为:" & Bin(testData) & vbCrLf & vbCrLf
        If SHL(testData, 4) Then
            str = str & "SHL,04:" & Bin(testData) & " 逻辑左移" & vbCrLf
        End If
        If SHL(testData, 10) Then
            str = str & "SHL,10:" & Bin(testData) & " 逻辑左移" & vbCrLf & vbCrLf
        End If
        
        testData = &H100
        If SHR(testData, 4) Then
            str = str & "SHR,04:" & Bin(testData) & " 逻辑右移" & vbCrLf
        End If
        testData = &H100
        If SHR(testData, 10) Then
            str = str & "SHR,10:" & Bin(testData) & " 逻辑右移" & vbCrLf & vbCrLf
        End If
        
        testData = &H100
        If SAL(testData, 4) Then
            str = str & "SAL,04:" & Bin(testData) & " 算术左移=逻辑左移" & vbCrLf & vbCrLf
        End If
        
        testData = &H100
        If SAR(testData, 4) Then
            str = str & "SAR,04:" & Bin(testData) & " 算术右移" & vbCrLf
        End If
        testData = &H100
        If SAR(testData, 10) Then
            str = str & "SAR,10:" & Bin(testData) & " 算术右移" & vbCrLf & vbCrLf
        End If
        
        
        testData = &H100
        If ROL(testData, 4) Then
            str = str & "ROL,04:" & Bin(testData) & " 循环左移" & vbCrLf
        End If
        testData = &H100
        If ROL(testData, 10) Then
            str = str & "ROL,10:" & Bin(testData) & " 循环左移" & vbCrLf & vbCrLf
        End If
        
        testData = &H100
        If RCL(testData, 4) Then
            str = str & "RCL,04:" & Bin(testData) & " 带进位循环左移" & vbCrLf
        End If
        testData = &H100
        If RCL(testData, 10) Then
            str = str & "RCL,10:" & Bin(testData) & " 带进位循环左移" & vbCrLf & vbCrLf
        End If
        
        testData = &H100
        If ROR(testData, 4) Then
            str = str & "ROR,04:" & Bin(testData) & " 循环右移" & vbCrLf
        End If
        testData = &H100
        If ROR(testData, 10) Then
            str = str & "ROR,10:" & Bin(testData) & " 循环右移" & vbCrLf & vbCrLf
        End If
        
        testData = &H100
        If RCR(testData, 4) Then
            str = str & "RCR,04:" & Bin(testData) & " 带进位循环右移" & vbCrLf
        End If
        testData = &H100
        If RCR(testData, 10) Then
            str = str & "RCR,10:" & Bin(testData) & " 带进位循环右移" & vbCrLf & vbCrLf
        End If
        
        
        testBitPlus = str & "结论:逻辑 算术左移一样,右移按照最高位有区别 ; 循环 差不多,就差 边缘的一位 " & vbCrLf & "推荐 使用 逻辑左右移 SHL SHR"
        
        
    End Function
    '逻辑左移
    Public Function SHL(ByRef Num As Variant, Optional ByVal iCL As Byte = 1) As Boolean
        Dim i As Byte
        Dim bMask As Byte, iMask As Integer, lMask As Long
        Select Case VarType(Num)
        Case 2                                                                      '16 bits
            For i = 1 To iCL
                iMask = 0
                If (Num And &H4000) <> 0 Then iMask = &H8000
                Num = (Num And &H3FFF) * 2 Or iMask
            Next
        Case 3                                                                      '32 bits
            For i = 1 To iCL
                lMask = 0
                If (Num And &H40000000) <> 0 Then lMask = &H80000000
                Num = (Num And &H3FFFFFFF) * 2 Or lMask
            Next
        Case 17                                                                     '8 bits
            For i = 1 To iCL
                bMask = 0
                If (Num And &H40) <> 0 Then bMask = &H80
                Num = (Num And &H3F) * 2 Or bMask
            Next
        Case Else
            SHL = False
            Exit Function
        End Select
        SHL = True
    End Function
    '逻辑右移
    Public Function SHR(ByRef Num As Variant, Optional ByVal iCL As Byte = 1) As Boolean
        Dim i As Byte
        Dim bMask As Byte, iMask As Integer, lMask As Long
        Select Case VarType(Num)
        Case 2                                                                      '16 bits
            For i = 1 To iCL
                iMask = 0
                If (Num And &H8000) <> 0 Then iMask = &H4000
                Num = (Num And &H7FFF) \ 2 Or iMask
            Next
        Case 3                                                                      '32 bits
            For i = 1 To iCL
                lMask = 0
                If (Num And &H80000000) <> 0 Then lMask = &H40000000
                Num = (Num And &H7FFFFFFF) \ 2 Or lMask
            Next
        Case 17                                                                     '8 bits
            For i = 1 To iCL
                bMask = 0
                If (Num And &H80) <> 0 Then bMask = &H40
                Num = (Num And &H7F) \ 2 Or bMask
            Next
        Case Else
            SHR = False
            Exit Function
        End Select
        SHR = True
    End Function
    '算术左移
    Public Function SAL(ByRef Num As Variant, Optional ByVal iCL As Byte = 1) As Boolean
        SAL = SHL(Num, iCL)
    End Function
    '算术右移
    Public Function SAR(ByRef Num As Variant, Optional ByVal iCL As Byte = 1) As Boolean
        Dim i As Byte
        Dim bMask As Byte, iMask As Integer, lMask As Long
        Select Case VarType(Num)
        Case 2                                                                      '16 bits
            For i = 1 To iCL
                iMask = 0
                If (Num And &H8000) <> 0 Then iMask = &HC000
                '和 逻辑 右移 区别就是 4000 => &HC00   0100 => 1100
                Num = (Num And &H7FFF) \ 2 Or iMask
            Next
        Case 3                                                                      '32 bits
            For i = 1 To iCL
                If (Num And &H80000000) <> 0 Then lMask = &HC0000000
                Num = (Num And &H7FFFFFFF) \ 2 Or lMask
            Next
        Case 17                                                                     '8 bits
            For i = 1 To iCL
                If (Num And &H80) <> 0 Then bMask = &HC0
                Num = (Num And &H7F) \ 2 Or bMask
            Next
        Case Else
            SAR = False
            Exit Function
        End Select
        SAR = True
    End Function
    '循环左移
    Public Function ROL(ByRef Num As Variant, Optional ByVal iCL As Byte = 1) As Boolean
        Dim i As Byte
        Dim bMask As Byte, iMask As Integer, lMask As Long
        Select Case VarType(Num)
        Case 2                                                                      '16 bits
            For i = 1 To iCL
                iMask = 0
                If (Num And &H4000) <> 0 Then iMask = &H8000
                If (Num And &H8000) <> 0 Then iMask = iMask Or &H1
                Num = (Num And &H3FFF) * 2 Or iMask
            Next
        Case 3                                                                      '32 bits
            For i = 1 To iCL
                lMask = 0
                If (Num And &H40000000) <> 0 Then lMask = &H80000000
                If (Num And &H80000000) <> 0 Then lMask = lMask Or &H1
                Num = (Num And &H3FFFFFFF) * 2 Or lMask
            Next
        Case 17                                                                     '8 bits
            For i = 1 To iCL
                bMask = 0
                If (Num And &H40) <> 0 Then bMask = &H80
                If (Num And &H80) <> 0 Then bMask = bMask Or &H1
                Num = (Num And &H3F) * 2 Or bMask
            Next
        Case Else
            ROL = False
            Exit Function
        End Select
        ROL = True
    End Function
    '循环右移
    Public Function ROR(ByRef Num As Variant, Optional ByVal iCL As Byte = 1) As Boolean
        Dim i As Byte
        Dim bMask As Byte, iMask As Integer, lMask As Long
        Select Case VarType(Num)
        Case 2                                                                      '16 bits
            For i = 1 To iCL
                iMask = 0
                If (Num And &H8000) <> 0 Then iMask = &H4000
                If (Num And &H1) <> 0 Then iMask = iMask Or &H8000
                Num = (Num And &H7FFF) \ 2 Or iMask
            Next
        Case 3                                                                      '32 bits
            For i = 1 To iCL
                lMask = 0
                If (Num And &H80000000) <> 0 Then lMask = &H40000000
                If (Num And &H1) <> 0 Then lMask = lMask Or &H80000000
                Num = (Num And &H7FFFFFFF) \ 2 Or lMask
            Next
        Case 17                                                                     '8 bits
            For i = 1 To iCL
                bMask = 0
                If (Num And &H80) <> 0 Then bMask = &H40
                If (Num And &H1) <> 0 Then bMask = bMask Or &H80
                Num = (Num And &H7F) \ 2 Or bMask
            Next
        Case Else
            ROR = False
            Exit Function
        End Select
        ROR = True
    End Function
    '带进位循环左移
    Public Function RCL(ByRef Num As Variant, Optional ByVal iCL As Byte = 1, Optional ByVal iCf As Byte = 0) As Boolean
        Dim i As Byte, CF As Byte
        Dim bMask As Byte, iMask As Integer, lMask As Long
        CF = iCf
        Select Case VarType(Num)
        Case 2                                                                      '16 bits
            For i = 1 To iCL
                If CF = 0 Then
                    iMask = 0
                Else
                    iMask = 1
                End If
                If (Num And &H4000) <> 0 Then iMask = iMask Or &H8000
                If (Num And &H8000) <> 0 Then
                    CF = 1
                Else
                    CF = 0
                End If
                Num = (Num And &H3FFF) * 2 Or iMask
            Next
        Case 3                                                                      '32 bits
            For i = 1 To iCL
                If CF = 0 Then
                    lMask = 0
                Else
                    lMask = 1
                End If
                If (Num And &H40000000) <> 0 Then lMask = lMask Or &H80000000
                If (Num And &H80000000) <> 0 Then
                    CF = 1
                Else
                    CF = 0
                End If
                Num = (Num And &H3FFFFFFF) * 2 Or lMask
            Next
        Case 17                                                                     '8 bits
            For i = 1 To iCL
                If CF = 0 Then
                    bMask = 0
                Else
                    bMask = 1
                End If
                If (Num And &H40) <> 0 Then bMask = bMask Or &H80
                If (Num And &H80) <> 0 Then
                    CF = 1
                Else
                    CF = 0
                End If
                Num = (Num And &H3F) * 2 Or bMask
            Next
        Case Else
            RCL = False
            Exit Function
        End Select
        RCL = True
    End Function
    '带进位循环右移
    Public Function RCR(ByRef Num As Variant, Optional ByVal iCL As Byte = 1, Optional ByVal iCf As Byte = 0) As Boolean
        Dim i As Byte, CF As Byte
        Dim bMask As Byte, iMask As Integer, lMask As Long
        CF = iCf
        Select Case VarType(Num)
        Case 2                                                                      '16 bits
            For i = 1 To iCL
                If CF = 1 Then
                    iMask = &H8000
                Else
                    iMask = 0
                End If
                If (Num And &H8000) <> 0 Then iMask = iMask Or &H4000
                If (Num And &H1) <> 0 Then
                    CF = 1
                Else
                    CF = 0
                End If
                Num = (Num And &H7FFF) \ 2 Or iMask
            Next
        Case 3                                                                      '32 bits
            For i = 1 To iCL
                If CF = 1 Then
                    lMask = &H80000000
                Else
                    lMask = 0
                End If
                If (Num And &H80000000) <> 0 Then lMask = lMask Or &H40000000
                If (Num And &H1) <> 0 Then
                    CF = 1
                Else
                    CF = 0
                End If
                Num = (Num And &H7FFFFFFF) \ 2 Or lMask
            Next
        Case 17                                                                     '8 bits
            For i = 1 To iCL
                If CF = 1 Then
                    bMask = &H80
                Else
                    bMask = 0
                End If
                If (Num And &H80) <> 0 Then bMask = bMask Or &H40
                If (Num And &H1) <> 0 Then
                    CF = 1
                Else
                    CF = 0
                End If
                Num = (Num And &H7F) \ 2 Or bMask
            Next
        Case Else
            RCR = False
            Exit Function
        End Select
        RCR = True
    End Function
    '将数值转化为二进制字符串
    Public Function Bin(ByVal Num As Variant) As String
        Dim tmpStr As String
        Dim iMask As Long
        Dim iCf As Byte, iMax As Byte
        Select Case VarType(Num)
        Case 2: iMax = 15                                                           'Integer 16 bits
        Case 3: iMax = 31                                                           'Long 32 bits
        Case 17: iMax = 7                                                           'Byte 8  bits
        Case Else
            Bin = ""
            Exit Function
        End Select
        iMask = 1
        If iMask And Num Then
            tmpStr = "1"
        Else
            tmpStr = "0"
        End If
        For iCf = 1 To iMax
            If iCf = 31 Then
                If Num > 0 Then
                    tmpStr = "0" + tmpStr
                Else
                    tmpStr = "1" + tmpStr
                End If
                Exit For
            End If
            iMask = iMask * 2
            If iMask And Num Then
                tmpStr = "1" + tmpStr
            Else
                tmpStr = "0" + tmpStr
            End If
            If (iCf + 1) Mod 4 = 0 Then
                tmpStr = " " + tmpStr
                'Debug.Print iCf & ":" & tmpStr
            End If
        Next
        Bin = tmpStr
    End Function

    测试代码

        Dim int2_1 As Integer
        int2_1 = &HF0AC
        Dim str As String
        str = "integer(2字节)与字节 的转换 " & vbCrLf & getHexOnly(int2_1) & vbCrLf & _
        getHexOnly(Int2ToBytes(int2_1)) & vbCrLf & _
        getHexOnly(BytesToInt2(Int2ToBytes(int2_1))) & vbCrLf & vbCrLf
        
        Dim int4 As Long
        int4 = &HFF00EEAA
        MsgBox str & "long(4字节)与字节 的转换 " & vbCrLf & getHexOnly(int4) & vbCrLf & _
        getHexOnly(Int4ToBytes(int4)) & vbCrLf & _
        getHexOnly(BytesToInt4(Int4ToBytes(int4)))
        

     可以看到经过两次转换,结果与原始数据相同!太成功了(图片文字有点小错误,不再上传图片修改了)

    将 各种类型的变量,以十六进制的形式打印出来

    '基本的 补全0
    Public Function hexfix(ByVal val As Byte) As String
        '补0
        If val < 16 Then
            hexfix = "0"
        End If
        hexfix = hexfix & Hex$(val)
    End Function
    
    '只获得十六进制,没有类型
    Public Function getHexOnly(ByVal val As Variant) As String
        getHexOnly = "0x "
        Select Case VarType(val)
        Case vbString:
            '8
            getHexOnly = getHexOnly(string2bytes(val))
        Case vbBytes
            '17
            getHexOnly = getHexOnly & Hex$(val)
        Case vbByte + vbArray
            '17+8192
            Dim i
            For i = 0 To UBound(val)
                getHexOnly = getHexOnly & hexfix(val(i)) & " "
            Next
        Case vbArray
            '8192
            getHexOnly = getHexOnly & " "
        Case vbBoolean
            '11
            getHexOnly = getHexOnly & " "
        Case vbInteger
            '2
            getHexOnly = getHexOnly & " "
        Case vbLong
            '3
            getHexOnly = getHexOnly & " "
        Case Decimal
            '14
            getHexOnly = getHexOnly & " "
        Case vbDouble
            '5
            getHexOnly = getHexOnly & " "
        Case vbEmpty
            '0
            getHexOnly = getHexOnly & " "
        Case vbError
            '10
            getHexOnly = getHexOnly & " "
        Case vbNull
            '1
            getHexOnly = getHexOnly & " "
        Case vbObject
            '9
            getHexOnly = getHexOnly & " "
        Case vbSingle
            '4
            getHexOnly = getHexOnly & " "
        Case vbVariant
            '12
            getHexOnly = getHexOnly & " "
        Case vbUserDefinedType
            '36
            getHexOnly = getHexOnly & " "
        Case Else
            If VarType(val) > 8192 Then
                getHexOnly = getHexOnly & "[]- -[]" & getVarTypeToString(VarType(val))
            Else
                MsgBox "What kind of  val" & "(" & VarType(val) & "[8192 0x2000 是vbArray ]) that is  " & TypeName(val)
            End If
        End Select
        
    End Function
    
    '不但打印类型,还有十六进制
    Public Function getHex(ByVal val) As String
        getHex = "[getHex Type is " & getVarTypeToString(VarType(val)) & "] " & vbCrLf & getHexOnly(val)
    End Function

    还没有将所有的类型都写完,基本的 bytes string integer long 有了。

    其实 上面 也可以写一个 getDecimalToString,就是按照每个字节,打印出来 整数,可以和十六进制对比。

    要知道,搞清楚上面的这些函数,费的时间很长。。需要对vb进行测试。

    vb来传输 Socket 数据包,按照字节编写的那种,没有这些基本函数怎么能行呢?

  • 相关阅读:
    oracle 体系结构 基本表空间介绍
    在用tiles框架的时候现了这样的错误
    java test 1
    SQL 日期函数小总结
    JavaEE 多层模型
    用 java 将文件的编码从GBK 转换成 UTF8收藏
    详解Java日期格式化及其使用例子
    java md5编码
    Tiles框架使用总结
    字符串分组求和收藏
  • 原文地址:https://www.cnblogs.com/ayanmw/p/2565670.html
Copyright © 2011-2022 走看看