有关shr

逻辑左移. SAL 算术左移.(=SHL) SHR 逻辑右移. SAR 算术右移.(=SHR) ROL 循环左移
. ROR
VB没有提供移位操作，你可以试试我下面的代码：
Private OnBits(0 To 31) As Long
Public Function LShiftLong(ByVal Value As Long, _
    ByVal Shift As Integer) As Long

    MakeOnBits

    If (Value And (2 ^ (31 - Shift))) Then GoTo OverFlow

    LShiftLong = ((Value And OnBits(31 - Shift)) * (2 ^ Shift))

    Exit FunctionOverFlow:

    LShiftLong = ((Value And OnBits(31 - (Shift + 1))) * _
       (2 ^ (Shift))) Or &H80000000

End FunctionPublic Function RShiftLong(ByVal Value As Long, _
   ByVal Shift As Integer) As Long
    Dim hi As Long
    MakeOnBits
    If (Value And &H80000000) Then hi = &H40000000

    RShiftLong = (Value And &H7FFFFFFE) \ (2 ^ Shift)
    RShiftLong = (RShiftLong Or (hi \ (2 ^ (Shift - 1))))
End Function

==================================================================
'**************************************
' Name: ~Bit Shifting
' Description:Left/Right Bit shifting fu
'     nctions
' By: Donald Moore (MindRape)
'
'This code is copyrighted and has' limited warranties.Please see http://w
'     ww.Planet-Source-Code.com/vb/scripts/Sho
'     wCode.asp?txtCodeId=2109&lngWId=1'for details.'**************************************'=======================================
'     ==========
'. .
'______ ______ .
'.:_\_ . \\_ .__\_::.
' . .::./ ./ // ./__ .:::. .
':_<_____/<______>_:.
'. .
' Damaged Cybernetics Laboratories
'
' It is a crime to redistribute these ro
'     utines in a commercial
' venture of any kind without permission
'     or a licensing agreement.
' Contact us via email for more informat
'     ion on licensing.
'
' This is freely distributable for non-c
'     ommercial use, however we
' require that you acknowledge the follo
'     wing:
'
' Copyright (c) 1999 Damaged Cybernetics
'     . All rights reserved.
'
' If you have any questions or comments,
'     please contact any of the
' following people via the Internet:
'
' Donald Moore (MindRape) moore@futureon
'     e.com
'=======================================
'     ==========
'Enumeration of bit-shifting
Public Enum dcShiftDirection
    Left = -1
    Right = 0
End Enum
'=======================================
'     ==========
'Public Function Shift(ByVal lValue As L
'     ong, ByVal lNumberOfBitsToShift As Long,
'     ByVal lDirectionToShift As dcShiftDirect
'     ion) As Long
'Author: Donald Moore (MindRape)
'E-mail: [email protected]
' Date: 06/16/99
'Enters:
' lValue as Long
' lNumberOfBitsToShift as Long
' lDirectionToShift as Long
'Returns:
' Long - shifted value
'Purpose:
' Shift the given value by the given num
'     ber of bits to shift in the given direct
'     ion.
' Shifting bits to the left acts as a mu
'     ltiplier and to the right divides.
Public Function Shift(ByVal lValue As Long, ByVal lNumberOfBitsToShift As Long, ByVal lDirectionToShift As dcShiftDirection) As Long
    Const ksCallname As String = "Shift"
    On Error Goto Procedure_Error
    Dim LShift As Long
    If lDirectionToShift Then 'shift left
        LShift = lValue * (2 ^ lNumberOfBitsToShift)
    Else 'shift right
        LShift = lValue \ (2 ^ lNumberOfBitsToShift)
    End If

    Procedure_Exit:
    Shift = LShift
    Exit Function

    Procedure_Error:
    Err.Raise Err.Number, ksCallname, Err.Description, Err.HelpFile, Err.HelpContext
    Resume Procedure_Exit
End Function
'=======================================
'     ==========
'Public Function LShift(ByVal lValue As
'     Long, ByVal lNumberOfBitsToShift As Long
'     ) As Long
'Author: Donald Moore (MindRape)
'E-mail: [email protected]
' Date: 06/16/99
'Enters:
' lValue as Long
' lNumberOfBitsToShift as Long
'Returns:
' Long - shifted value
'Purpose:
' Shift the given value by the given num
'     ber of bits left
Public Function LShift(ByVal lValue As Long, ByVal lNumberOfBitsToShift As Long) As Long
    Const ksCallname As String = "LShift"
    On Error Goto Procedure_Error
    LShift = Shift(lValue, lNumberOfBitsToShift, Left)

    Procedure_Exit:
    Exit Function

    Procedure_Error:
    Err.Raise Err.Number, ksCallname, Err.Description, Err.HelpFile, Err.HelpContext
    Resume Procedure_Exit
End Function
'=======================================
'     ==========
'Public Function RShift(ByVal lValue As
'     Long, ByVal lNumberOfBitsToShift As Long
'     ) As Long
'Author: Donald Moore (MindRape)
'E-mail: [email protected]
' Date: 06/16/99
'Enters:
' lValue as Long
' lNumberOfBitsToShift as Long
'Returns:
' Long - shifted value
'Purpose:
' Shift the given value by the given num
'     ber of bits right
Public Function RShift(ByVal lValue As Long, ByVal lNumberOfBitsToShift As Long) As Long
    Const ksCallname As String = "RShift"
    On Error Goto Procedure_Error
    RShift = Shift(lValue, lNumberOfBitsToShift, Right)

    Procedure_Exit:
    Exit Function

    Procedure_Error:
    Err.Raise Err.Number, ksCallname, Err.Description, Err.HelpFile, Err.HelpContext
    Resume Procedure_Exit
End Function
Private Sub MakeOnBits()
    Dim j As Integer, _
        v As Long

    For j = 0 To 30

        v = v + (2 ^ j)
        OnBits(j) = v

    Next j

    OnBits(j) = v + &H80000000End Sub

解决方案 »