Bit Shift

年に1回くらいは誰でもVBSやVBAでビットシフトをしたくなることがありますよね？

算術ビットシフトは間違ってるかもしれませんが。

---

Option Explicit

'-----------------------------------------------------------
' definition
'-----------------------------------------------------------

Dim g_aryPower
Dim g_aryMask
Dim g_aryRevMask

'2^i
g_aryPower = Array( _
    &H1&, &H2&, &H4&, &H8&, _
    &H10&, &H20&, &H40&, &H80&, _
    &H100&, &H200&, &H400&, &H800&, _
    &H1000&, &H2000&, &H4000&, &H8000&, _
    &H10000, &H20000, &H40000, &H80000, _
    &H100000, &H200000, &H400000, &H800000, _
    &H1000000, &H2000000, &H4000000, &H8000000, _
    &H10000000, &H20000000, &H40000000, &H80000000, _
    &H0&)

'2^i-1
g_aryMask = Array( _
    &H0&, &H1&, &H3&, &H7&, _
    &HF&, &H1F&, &H3F&, &H7F&, _
    &HFF&, &H1FF&, &H3FF&, &H7FF&, _
    &HFFF&, &H1FFF&, &H3FFF&, &H7FFF&, _
    &HFFFF&, &H1FFFF, &H3FFFF, &H7FFFF, _
    &HFFFFF, &H1FFFFF, &H3FFFFF, &H7FFFFF, _
    &HFFFFFF, &H1FFFFFF, &H3FFFFFF, &H7FFFFFF, _
    &HFFFFFFF, &H1FFFFFFF, &H3FFFFFFF, &H7FFFFFFF, _
    &HFFFFFFFF)

'2^8-2^i+1
g_aryRevMask = Array( _
    &HFFFFFFFF, &HFFFFFFFE, &HFFFFFFFC, &HFFFFFFF8, _
    &HFFFFFFF0, &HFFFFFFE0, &HFFFFFFC0, &HFFFFFF80, _
    &HFFFFFF00, &HFFFFFE00, &HFFFFFC00, &HFFFFF800, _
    &HFFFFF000, &HFFFFE000, &HFFFFC000, &HFFFF8000, _
    &HFFFF0000, &HFFFE0000, &HFFFC0000, &HFFF80000, _
    &HFFF00000, &HFFE00000, &HFFC00000, &HFF800000, _
    &HFF000000, &HFE000000, &HFC000000, &HF8000000, _
    &HF0000000, &HE0000000, &HC0000000, &H80000000, _
    &H0&)

'-----------------------------------------------------------

call test(-128)
WScript.Quit

'テスト / test
'使い方 / usage
Sub test(val)
    Dim i
    Dim j
    Dim l
    Dim r
    
    For i = 1 to 4
        For j = 1 to 32
            If j mod 16 = 1 Then r = "test : " & val & " (" & Dec2Bin32(val) & ")"
            Select Case i
                Case 1
                    l = LogicalBitShiftToLeft(val, j)
                    r = r & vbLf & right(" " & j, 2) & " <<< " & Dec2Bin32(l) & _
                        " (" & l & ")"
                Case 2
                    l = LogicalBitShiftToRight(val, j)
                    r = r & vbLf & right(" " & j, 2) & " >>> " & Dec2Bin32(l) & _
                        " (" & l & ")"
                Case 3
                    l = ArithmeticBitShiftToLeft(val, j)
                    r = r & vbLf & right(" " & j, 2) & " << " & Dec2Bin32(l) & _
                        " (" & l & ")"
                Case 4
                    l = ArithmeticBitShiftToRight(val, j)
                    r = r & vbLf & right(" " & j, 2) & " >> " & Dec2Bin32(l) & _
                        " (" & l & ")"
            End Select
        If j mod 16 = 0 Then Msgbox r
        Next
    Next
End Sub

'-----------------------------------------------------------

'左論理ビットシフト / logical bit shift to left
'    val: long value
'    shiftnum: number of bit
'    return: long value
Function LogicalBitShiftToLeft(val, shiftnum)
    Dim lng
    lng = Clng(val)
    If shiftnum > 0 And shiftnum < 32 Then
        LogicalBitShiftToLeft = (lng And g_aryMask(31 - shiftnum)) * _
                                g_aryPower(shiftnum)
        If lng And g_aryPower(31 - shiftnum) Then _
            LogicalBitShiftToLeft = LogicalBitShiftToLeft Or &H80000000&
    ElseIf shiftnum <= 0 Then
        LogicalBitShiftToLeft = lng
    ElseIf shiftnum >= 32 Then
        LogicalBitShiftToLeft = &H0&
    End If
End Function


'左算術ビットシフト / arithmetic bit shift to left
'    val: long value
'    shiftnum: number of bit
'    return: long value
Function ArithmeticBitShiftToLeft(val, shiftnum)
    Dim lng
    lng = Clng(val)
    If shiftnum > 0 And shiftnum < 31 Then
        If lng And &H80000000& Then
            lng = lng Or g_aryRevMask(31 - shiftnum)
        Else
            lng = lng And g_aryMask(31 - shiftnum)
        End If
        ArithmeticBitShiftToLeft = lng * g_aryPower(shiftnum)
    ElseIf shiftnum <= 0 Then
        ArithmeticBitShiftToLeft = lng
    ElseIf shiftnum >= 31 Then
        If lng And &H80000000& Then
            ArithmeticBitShiftToLeft = &H80000000&
        Else
            ArithmeticBitShiftToLeft = &H0&
        End If
    End If
End Function

'右論理ビットシフト / logical bit shift to right
'    val: long value
'    shiftnum: number of bit
'    return: long value
Function LogicalBitShiftToRight(val, shiftnum)
    Dim lng
    lng = Clng(val)
    If shiftnum > 0 And shiftnum < 32 Then
        LogicalBitShiftToRight = (lng And g_aryRevMask(shiftnum)) \ _
                                 g_aryPower(shiftnum) And g_aryMask(32 - shiftnum)
    ElseIf shiftnum <= 0 Then
        LogicalBitShiftToRight = lng
    ElseIf shiftnum >= 32 Then
        LogicalBitShiftToRight = &H0&
    End If
End Function


'右算術ビットシフト / arithmetic bit shift to right
'    val: long value
'    shiftnum: number of bit
'    return: long value
Function ArithmeticBitShiftToRight(val, shiftnum)
    Dim lng
    lng = Clng(val)
    If shiftnum > 0 And shiftnum < 31 Then
        ArithmeticBitShiftToRight = (lng And g_aryRevMask(shiftnum)) \ _
                                    g_aryPower(shiftnum)
    ElseIf shiftnum <= 0 Then
        ArithmeticBitShiftToRight = lng
    ElseIf shiftnum >= 31 Then
        If lng And &H80000000& Then
            ArithmeticBitShiftToRight = &HFFFFFFFF&
        Else
            ArithmeticBitShiftToRight = &H0&
        End If
    End If
End Function


'Longを2進数の文字列に変換 / convert long value to digit string
'    val: long value
'    return: string
Function Dec2Bin32(val)
    Dim i
    Dim lng

    lng = Clng(val)
    
    For i = 0 To 31
        If g_aryPower(31 - i) And lng Then
            Dec2Bin32 = Dec2Bin32 & "1"
        Else
            Dec2Bin32 = Dec2Bin32 &  "0"
        End If
    Next
End Function