按位运算从双精度转换为整数？
不幸的是，我必须在VBA for Excel中完成这一切，但我试图弄清楚是否有一种方法需要一个通常是任何其他语言的无符号整数的数字，做一些事情（加，乘等）。 ）作为VBA中的double精度型，然后将其转换回VBA中的Long ，将其作为无符号长整型的按位等效，以便我可以对其执行一些按位操作（特定xor）。
如果可以的话，我会很乐意做一些DLL来调用它，但在这种环境下是不可能的。
对此有何想法？
在尝试在VBA中实现哈希值时，我也有类似的需求。 我感到沮丧的是，缺乏轮class，漫长的和多字节的逻辑操作。 我创build了一个ByteSet类，并用它来构build一个CDbltoLng函数。
这是转换function。 有关双打格式的信息可以在这里find。 把它放在一个标准模块中：
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中的几乎任何数字数据types中获取字节，然后根据需要操作字节。
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