64位无符号整数

tlwh163

Option Explicit

''==================================
''  无符号64位整数 QWord 类模块
''==================================

Private Declare Sub GetMem1 Lib "msvbvm60" (ByVal Ptr As Long, Ret As Any)
Private Declare Sub GetMem2 Lib "msvbvm60" (ByVal Ptr As Long, Ret As Any)
Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Ptr As Long, Ret As Any)
Private Declare Sub GetMem8 Lib "msvbvm60" (ByVal Ptr As Long, Ret As Any)

''Decimal类型:  { 小数位[1Byte], 符号位[1Byte], 数值区[64-95位(4Byte),00-31位(4Byte),32-63位(4Byte)] }
''Variant类型:  { 类型符[2Byte,固定=14], Decimal[14Byte] }

Private CMax_ As Variant       'CDec("18446744073709551615")  '0xFFFFFFFF_FFFFFFFF
Private m_Ptr As Long          'QWord数值区低64位首地址
Private m_Var(0 To 1) As Long  'QWord缓存区(8字节)

Private Sub Class_Initialize()
    CMax_ = CDec("18446744073709551615")  '0xFFFFFFFF_FFFFFFFF
    Erase m_Var: m_Ptr = VarPtr(m_Var(0))
End Sub

Private Sub Class_Terminate()
    m_Ptr = 0: Erase m_Var: CMax_ = Empty
End Sub

''赋值(将参数传来的数据,修正为64位无符号数值)
Public Property Let ValueOf(ByRef wValue As Variant)
    Dim a As Byte, e As Long, w As Variant: w = CDec(wValue)
    GetMem1 VarPtr(w) + 2, a: If (a) Then w = Fix(w) + 0    '截断小数(并消除-0)
    GetMem4 VarPtr(w) + 4, e: If (e) Then Err.Raise vbObjectError + 6 '溢出报错
    GetMem1 VarPtr(w) + 3, a: If (a) Then w = w + CMax_ + 1       '负数: 取反+1
    GetMem8 VarPtr(w) + 8, ByVal m_Ptr               '将低64位拷贝到QWord缓存区
End Property

''返回值
Public Property Get ValueOf() As Variant
    ValueOf = CDec(0)
    GetMem8 m_Ptr, ByVal VarPtr(ValueOf) + 8
End Property

''返回首地址
Public Property Get VarPtrOf() As Long
    VarPtrOf = m_Ptr
End Property

''返回QWord的Size 当然=8
Public Property Get SizeOf()
    SizeOf = 8
End Property

''返回QWord的16进制字符串(可以任意指定返回长度[1-255])
Public Property Get toHex(Optional ByVal n As Byte = 0) As String
    Dim a As String, k As Long: toHex = String(255, "0"): k = 1
    If m_Var(0) Then a = Hex(m_Var(0)): k = Len(a): Mid(toHex, 256 - k, k) = a
    If m_Var(1) Then a = Hex(m_Var(1)): k = Len(a): Mid(toHex, 248 - k, k) = a: k = k + 8
    If n <= 0 Then n = k
    toHex = Mid(toHex, 256 - n, n)
End Property

''从16进制字符串中获取数值("&HAABBCCDD12345678"或者"FEBA9821")
Public Sub formHex(hStr As String)
    Dim x(0 To 7) As Byte, i As Long, j As Boolean
    Dim k0 As Long, k1 As Long: k0 = 1: k1 = Len(hStr)
    If k1 >= 2 And Mid(hStr, 1, 2) = "&H" Then k0 = 3
    If (k1 - k0) >= 16 Then Err.Raise vbObjectError + 6 '溢出报错
    For k1 = k1 To k0 Step -1
        Dim c As Integer: c = Asc(Mid(hStr, k1, 1))
        Select Case c
            Case 48 To 57: c = c - 48
            Case 65 To 70: c = c - 55
            Case 97 To 102: c = c - 87
            Case Else: Err.Raise vbObjectError + 13 '类型不匹配
        End Select: j = Not j
        If j Then x(i) = c Else x(i) = x(i) + c * 16: i = i + 1
    Next
    GetMem8 VarPtr(x(0)), ByVal m_Ptr  '将低64位拷贝到QWord缓存区
End Sub

tlwh163

Option Explicit

''==================================
''  无符号32位整数 DWord 类模块
''==================================

Private Declare Sub GetMem1 Lib "msvbvm60" (ByVal Ptr As Long, Ret As Any)
Private Declare Sub GetMem2 Lib "msvbvm60" (ByVal Ptr As Long, Ret As Any)
Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Ptr As Long, Ret As Any)
Private Declare Sub GetMem8 Lib "msvbvm60" (ByVal Ptr As Long, Ret As Any)

''Decimal类型:  { 小数位[1Byte], 符号位[1Byte], 数值区[64-95位(4Byte),00-31位(4Byte),32-63位(4Byte)] }
''Variant类型:  { 类型符[2Byte,固定=14], Decimal[14Byte] }

Private CMaxDWord As Variant   'CDec("4294967295")  '0xFFFFFFFF
Private m_Ptr As Long          'DWord数值区低32位首地址
Private m_Var As Variant       'DWord缓存区(Decimal类型的变体)

Private Sub Class_Initialize()
    CMaxDWord = CDec("4294967295")  '0xFFFFFFFF
    m_Var = CDec(0): m_Ptr = VarPtr(m_Var) + 8
End Sub

Private Sub Class_Terminate()
    m_Var = Empty
End Sub

''赋值(将参数传来的数据,修正为32位无符号数值)
Public Property Let ValueOf(ByRef wValue As Variant)
    Dim a As Byte, e As Long, w As Variant: w = CDec(wValue)
    GetMem1 VarPtr(w) + 2, a: If (a) Then w = Fix(w) + 0    '截断小数(并消除-0)
    GetMem4 VarPtr(w) + 12, e: If (e) Then Err.Raise vbObjectError + 6 '溢出报错
    GetMem4 VarPtr(w) + 4, e: If (e) Then Err.Raise vbObjectError + 6  '溢出报错
    GetMem1 VarPtr(w) + 3, a: If (a) Then w = w + CMaxDWord + 1   '负数: 取反+1
    GetMem4 VarPtr(w) + 8, ByVal m_Ptr         '将低32位拷贝到DWord缓存区
End Property

''返回值
Public Property Get ValueOf() As Variant
    ValueOf = m_Var
End Property

''返回首地址
Public Property Get VarPtrOf() As Long
    VarPtrOf = m_Ptr
End Property

''返回16进制字符串(可以任意指定返回长度[1-255])
Public Property Get toHex(Optional ByVal n As Byte = 0) As String
    Dim a As String, k As Long, x As Long: toHex = String(255, 48): k = 1
    GetMem4 m_Ptr + 0, x: If x Then a = Hex(x): k = Len(a): Mid(toHex, 256 - k, k) = a
    If n <= 0 Then n = k: End If: toHex = Mid(toHex, 256 - n, n)
End Property

tlwh163

    Dim x As New QWord
    Text.Text = "AABBCCDD12345678"
    x.formHex Text1.Text: Print x.ValueOf: Print
    Print "+ 10", x.ValueOf + 10
    Print "- 10", x.ValueOf - 10
    'x.formHex Text1.Text: x.ValueOf = x.ValueOf * 1.2: Print "* 1.2", x.ValueOf
    Print "* 1.2", Fix(x.ValueOf * 1.2)
    'x.formHex Text1.Text: x.ValueOf = x.ValueOf / 13: Print "/ 13", x.ValueOf
    Print "/ 13", Fix(x.ValueOf / 13)