按位运算从双精度转换为整数？

Question

不幸的是，我必须在VBA for Excel中完成所有操作，但是我想弄清楚是否有一种方法可以采用任何其他语言的无符号整数，做一些事情（添加，乘法）等等，它作为VBA中的double，然后将其转换回VBA中的Long，它可以作为无符号长度的按位等效，这样我就可以做一些按位操作（特别是xor）就可以了。

如果可以的话，我很乐意只是制作一种DLL来调用它，但是在这种情况下它是不可能的。

对此有何想法？

Answer 1

尝试在VBA中实现哈希时，我有类似的需求。我对缺乏轮班，漫游和多字节逻辑操作感到沮丧。我创建了一个ByteSet类，并用它来构建CDbltoLng函数。

这是转换功能。可以找到有关双打格式的信息here。将其放在标准模块中：

Public Function CDblToLng(num As Double) As Long

    Dim DblBytes As clsByteSet
    Set DblBytes = New clsByteSet
    DblBytes.fromDouble num

    Dim SignMask As clsByteSet
    Dim ExponentMask As clsByteSet
    Dim MantissaMask As clsByteSet

    Set SignMask = New clsByteSet
    Set ExponentMask = New clsByteSet
    Set MantissaMask = New clsByteSet

    SignMask.fromCustomBytes &H80, 0, 0, 0, 0, 0, 0, 0
    ExponentMask.fromCustomBytes &H7F, &HF0, 0, 0, 0, 0, 0, 0
    MantissaMask.fromCustomBytes 0, &HF, &HFF, &HFF, &HFF, &HFF, &HFF, &HFF

    Dim negative As Byte
    negative = DblBytes.Clone.AND_ByteSet(SignMask).ShiftRight(63).toByte

    Dim ExponentInteger As Integer
    ExponentInteger = DblBytes.Clone.AND_ByteSet(ExponentMask).ShiftRight(52).toInteger - 1023

    Dim LongNumber As Long
    LongNumber = DblBytes.Clone.AND_ByteSet(MantissaMask).ShiftRight(52 - ExponentInteger).toLong

    If negative Then
        If ExponentInteger = 31 Then
            CDblToLng = (Not (LongNumber Or &H80000000)) + 1
        Else
            CDblToLng = (Not (LongNumber Or 2 ^ ExponentInteger)) + 1 'Or (IIf(negative, -1, 1) * 2 ^ ExponentInteger)
        End If
    Else
        If ExponentInteger = 31 Then
            CDblToLng = LongNumber Or &H80000000
        Else
            If ExponentInteger <= 30 Then
                CDblToLng = LongNumber Or 2 ^ ExponentInteger
            Else
                CDblToLng = LongNumber
            End If
        End If
    End If
End Function

这里是clsByteSet。您可以从VBA中的任何数值数据类型中提取字节，然后根据需要操作字节。

Option Compare Database

'Updated to be a Fluent Interface

Private Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (dest As Any, source As Any, ByVal length As Long)

Private m_arrBytes() As Byte

Public Function Resize(n As Long) As clsByteSet
    ReDim m_arrBytes(0 To n - 1)
End Function

Public Function fromCustomBytes(ParamArray bytes()) As clsByteSet
    ReDim m_arrBytes(0 To UBound(bytes))
    For i = 0 To UBound(bytes)
        m_arrBytes(i) = CByte(bytes(i))
    Next

    Set fromCustomBytes = Me
End Function

Public Function fromDouble(Dbl As Double) As clsByteSet
    ReDim m_arrBytes(0 To 7)
    For i = 0 To 7
        CopyMemory ByVal VarPtr(m_arrBytes(i)), ByVal CLng(VarPtr(Dbl) + (7& - i)), 1
    Next

    Set fromDouble = Me
End Function

Public Function fromLong(lng As Long) As clsByteSet
    ReDim m_arrBytes(0 To 3)
    For i = 0 To 3
        CopyMemory ByVal VarPtr(m_arrBytes(i)), ByVal CLng(VarPtr(lng) + (3& - i)), 1
    Next

    Set fromLong = Me
End Function

Public Function fromInteger(intgr As Integer) As clsByteSet
    ReDim m_arrBytes(0 To 1)
    For i = 0 To 1
        CopyMemory ByVal VarPtr(m_arrBytes(i)), ByVal CLng(VarPtr(intgr) + (1& - i)), 1
    Next

    Set fromInteger = Me
End Function

Public Function fromByte(b As Byte) As clsByteSet
    ReDim m_arrBytes(0 To 1 - 1)
    m_arrBytes(0) = b

    Set fromByte = Me
End Function

Public Function fromBytes(b() As Byte) As clsByteSet
    ReDim m_arrBytes(LBound(b) To UBound(b))
    For i = LBound(b) To UBound(b)
        m_arrBytes(i) = b(i)
    Next

    Set fromBytes = Me
End Function

Public Property Get bytes() As Byte()
    bytes = m_arrBytes
End Property

Public Property Get bytesbyte(index As Long) As Byte
    bytesbyte = m_arrBytes(index)
End Property

Public Function Clone() As clsByteSet
    Set Clone = New clsByteSet
    Clone.fromBytes m_arrBytes
End Function

Public Function toBytes() As Byte()
    ReDim toBytes(LBound(m_arrBytes) To UBound(m_arrBytes))
    For i = LBound(m_arrBytes) To UBound(m_arrBytes)
        toBytes(i) = m_arrBytes(i)
    Next
End Function

Public Function toByte() As Byte
    Dim b As Byte
    b = m_arrBytes(UBound(m_arrBytes))
    toByte = b
End Function

Public Function toInteger() As Integer
    Dim intgr As Integer
    For i = 0 To 1
        CopyMemory ByVal CLng(VarPtr(intgr) + (1& - i)), ByVal VarPtr(m_arrBytes(i + UBound(m_arrBytes) - 1)), 1
    Next
    toInteger = intgr
End Function

Public Function toLong() As Long
    Dim lng As Long
    For i = 0 To 3
        CopyMemory ByVal CLng(VarPtr(lng) + (3& - i)), ByVal VarPtr(m_arrBytes(i + UBound(m_arrBytes) - 3)), 1
    Next
    toLong = lng
End Function

Public Function toDouble() As Double
    Dim Dbl As Double
    For i = 0 To 7
        CopyMemory ByVal CLng(VarPtr(Dbl) + (7& - i)), ByVal VarPtr(m_arrBytes(i + UBound(m_arrBytes) - 7)), 1
    Next
    toDouble = Dbl
End Function

Public Function toString() As String
    Dim strOutput As String
    Dim i As Long
    If UBound(m_arrBytes) > 0 Then
        strOutput = right("0" & Hex(m_arrBytes(0)), 2)
        i = 1
        While i <= UBound(m_arrBytes)
            strOutput = strOutput & " " & right("0" & Hex(m_arrBytes(i)), 2)
            i = i + 1
        Wend
    End If
    toString = strOutput
End Function

'************************************************************************************************************************************
'* Bitwise Boolean *
'*******************

Public Function XOR_ByteSet(bs As clsByteSet) As clsByteSet
    For i = 0 To UBound(bs.bytes)
        m_arrBytes(i) = m_arrBytes(i) Xor bs.bytes(i)
    Next

    Set XOR_ByteSet = Me
End Function

Public Function AND_ByteSet(bs As clsByteSet) As clsByteSet
    Dim i As Long
    For i = 0 To UBound(bs.bytes)
        m_arrBytes(i) = m_arrBytes(i) And bs.bytesbyte(i)
    Next

    Set AND_ByteSet = Me
End Function

Public Function OR_ByteSet(bs As clsByteSet) As clsByteSet
    For i = 0 To UBound(bs.bytes)
        m_arrBytes(i) = m_arrBytes(i) Or bs.bytes(i)
    Next

    Set OR_ByteSet = Me
End Function


'************************************************************************************************************************************
'* Shifts and Rotates *
'**********************

Public Function ShiftRight(length As Long) As clsByteSet
'Inefficient because it performs two operations: shift bytes then shift bits
    If length > UBound(m_arrBytes) + 1 Then
        'Error
    End If

    Dim shiftbits As Byte
    Dim shiftbytes As Long


    shiftbytes = length \ 8
    shiftbits = length Mod 8

    Dim i As Long

    If shiftbytes > 0 Then

        For i = UBound(m_arrBytes) To shiftbytes Step -1
            m_arrBytes(i) = m_arrBytes(i - shiftbytes)
        Next
        For i = shiftbytes - 1 To 0 Step -1
            m_arrBytes(i) = 0
        Next

    End If

    If shiftbits > 0 Then

        For i = UBound(m_arrBytes) To 1 Step -1
            m_arrBytes(i) = ShiftByteRight(m_arrBytes(i), shiftbits) Or ShiftByteLeft(m_arrBytes(i - 1), 8 - shiftbits)
        Next
        m_arrBytes(0) = ShiftByteRight(m_arrBytes(i), shiftbits)

    End If

    Set ShiftRight = Me
End Function

Public Function ShiftLeft(length As Long) As clsByteSet
'Inefficient because it performs two operations: shift bytes then shift bits
    If length > UBound(m_arrBytes) + 1 Then
        'Error
    End If
    Dim shiftbits As Byte
    Dim shiftbytes As Long

    shiftbytes = length \ 8
    shiftbits = length Mod 8

    Dim i As Long

    If shiftbytes > 0 Then

        For i = 0 To UBound(m_arrBytes) - shiftbytes
            m_arrBytes(i) = m_arrBytes(i + shiftbytes)
        Next
        For i = UBound(m_arrBytes) - shiftbytes To UBound(m_arrBytes)
            m_arrBytes(i) = 0
        Next

    End If

    If shiftbits > 0 Then

        For i = 0 To UBound(m_arrBytes) - 1
            m_arrBytes(i) = ShiftByteLeft(m_arrBytes(i), shiftbits) Or ShiftByteRight(m_arrBytes(i + 1), 8 - shiftbits)
        Next
        m_arrBytes(i) = ShiftByteLeft(m_arrBytes(i), shiftbits)

    End If

    Set ShiftLeft = Me
End Function

Public Function RotateRight(length As Long) As clsByteSet
'Inefficient because it performs two operations: shift bytes then shift bits
    If length > (UBound(m_arrBytes) + 1) * 8 Then
        length = length Mod (UBound(m_arrBytes) + 1)
    End If
    Dim shiftbits As Byte
    Dim shiftbytes As Long

    shiftbytes = length \ 8
    shiftbits = length Mod 8

    Dim i As Long

    If shiftbytes > 0 Then

        Dim temparr() As Byte
        ReDim temparr(0 To shiftbytes - 1)
        For i = 0 To shiftbytes - 1
            temparr(i) = m_arrBytes(i + (UBound(m_arrBytes) - (shiftbytes - 1)))
        Next
        For i = UBound(m_arrBytes) To shiftbytes Step -1
            m_arrBytes(i) = m_arrBytes((i - shiftbytes))
        Next
        For i = shiftbytes - 1 To 0 Step -1
            m_arrBytes(i) = temparr(i)
        Next

    End If

    If shiftbits > 0 Then

        Dim tempbyte As Byte
        tempbyte = ShiftByteLeft(m_arrBytes(UBound(m_arrBytes)), 8 - shiftbits)
        For i = UBound(m_arrBytes) To 1 Step -1
            m_arrBytes(i) = ShiftByteLeft(m_arrBytes(i - 1), 8 - shiftbits) Or ShiftByteRight(m_arrBytes(i), shiftbits)
        Next
        m_arrBytes(0) = ShiftByteRight(m_arrBytes(0), shiftbits) Or tempbyte

    End If

    Set RotateRight = Me
End Function

Public Function RotateLeft(length As Long) As clsByteSet
'Inefficient because it performs two operations: shift bytes then shift bits
    If length > (UBound(m_arrBytes) + 1) * 8 Then
        length = length Mod (UBound(m_arrBytes) + 1)
    End If
    Dim shiftbits As Byte
    Dim shiftbytes As Long

    shiftbytes = length \ 8
    shiftbits = length Mod 8

    Dim i As Long

    If shiftbytes > 0 Then

        Dim temparr() As Byte
        ReDim temparr(0 To shiftbytes - 1)
        For i = 0 To shiftbytes - 1
            temparr(i) = m_arrBytes(i)
        Next
        For i = 0 To UBound(m_arrBytes) - shiftbytes
            m_arrBytes(i) = m_arrBytes((i + shiftbytes))
        Next
        For i = 0 To shiftbytes - 1
            m_arrBytes(i + UBound(m_arrBytes) - (shiftbytes - 1)) = temparr(i)
        Next

    End If

    If shiftbits > 0 Then

        Dim tempbyte As Byte
        tempbyte = ShiftByteRight(m_arrBytes(0), 8 - shiftbits)
        For i = 0 To UBound(m_arrBytes) - 1
            m_arrBytes(i) = ShiftByteLeft(m_arrBytes(i), shiftbits) Or ShiftByteRight(m_arrBytes(i + 1), 8 - shiftbits)
        Next
        m_arrBytes(UBound(m_arrBytes)) = ShiftByteLeft(m_arrBytes(UBound(m_arrBytes)), shiftbits) Or tempbyte

    End If

    Set RotateLeft = Me
End Function

Private Function ShiftByteRight(ByVal data As Byte, length As Byte) As Byte
    ShiftByteRight = data \ (2 ^ (length))
End Function

Private Function ShiftByteLeft(ByVal data As Byte, length As Byte) As Byte
    ShiftByteLeft = (data And ((2 ^ (8 - length)) - 1)) * (2 ^ length)
End Function