不幸的是，我不得不在VBA for Excel中這樣做，但我試圖弄清楚是否有一種方法需要一個通常是任何其他語言的無符號整數的數字，做一些事情（添加，乘，等等），作爲VBA中的double，然後將其轉換回VBA中的Long，將其作爲無符號長整型的按位等效，以便我可以對其執行一些按位操作（特定xor）。按位運算從雙精度轉換爲整數？
如果可以的話，我會很高興地創建一些DLL來調用它，但在這種環境下是不可能的。
對此有何看法？
我有一個類似的需求，同時試圖在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
這確實會增加我的算法時間複雜度，但它確實符合我的要求。 – supercheetah 2014-09-23 03:43:02
爲什麼在複製到'm_arrBytes'時迭代'clsByteSet'中的對象的每個字節，而不是隻將大小指定爲'CopyMemory'的最後一個參數？ – supercheetah 2014-09-23 03:57:49
@supercheetah查看本維基百科文章：[Endianness]（http://en.wikipedia.org/wiki/Endianness）。 Double/Long/Integer的字節存儲在Little Endian中。例如，長整型值＆H0A0B0C0D將按相反順序存儲爲4個單獨的字節：| 0D | 0C | 0B | 0A |。現在回顧一下，我確信Win32 api必須提供更好的方法，但是我想確定我的類的接口，並擔心稍後優化實現。如果您有任何建議，請告訴我！ – Blackhawk 2014-09-23 12:42:34
爲什麼它需要是一個雙？它的範圍是什麼？您是否考慮過使用['Decimal'數據類型？]（http://msdn.microsoft.com/zh-cn/library/xtba3z33.aspx） – 2014-09-22 19:07:50
這些數字大於2^31，但仍小於2^32。 – supercheetah 2014-09-22 19:10:50
我不知道'Decimal'類型。我會玩這個。它可能工作。 – supercheetah 2014-09-22 19:12:20