按位運算從雙精度轉換爲整數？

不幸的是，我不得不在VBA for Excel中這樣做，但我試圖弄清楚是否有一種方法需要一個通常是任何其他語言的無符號整數的數字，做一些事情（添加，乘，等等），作爲VBA中的double，然後將其轉換回VBA中的Long，將其作爲無符號長整型的按位等效，以便我可以對其執行一些按位操作（特定xor）。按位運算從雙精度轉換爲整數？

如果可以的話，我會很高興地創建一些DLL來調用它，但在這種環境下是不可能的。

對此有何看法？

來源

2014-09-22 supercheetah

爲什麼它需要是一個雙？它的範圍是什麼？您是否考慮過使用['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

我有一個類似的需求，同時試圖在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

來源

2014-09-22 21:20:14 Blackhawk

這確實會增加我的算法時間複雜度，但它確實符合我的要求。 – 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

按位運算從雙精度轉換爲整數？

回答

相關問題