页首Html代码

返回顶部

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 数据包，按照字节编写的那种，没有这些基本函数怎么能行呢？

posted @ 2012-06-27 13:34  ayanmw  阅读(6515)  评论(0)  编辑  收藏  举报

页脚Html代码