VB 负数移位 急急急……

Private Type LARGEINT

  Long1 As Long

  Long2 As Long

End Type



Private Declare Function RLIShiftLeft Lib "ntdll" Alias "RtlLargeIntegerShiftLeft" (ByVal Val1 As Long, ByVal Val2 As Long, ByVal ShiftCount As Long) As LARGEINT



Private Declare Function RLIShiftRight Lib "ntdll" Alias "RtlLargeIntegerShiftRight" (ByVal Val1 As Long, ByVal Val2 As Long, ByVal ShiftCount As Long) As LARGEINT

Option Explicit

Private Const BinTbl = "0000;0001;0010;0011;0100;0101;0110;0111;1000;1001;1010;1011;1100;1101;1110;1111;"

Private Const HexTbl = "0123456789ABCDEF"



Function MoveRight$(ByVal BaseNum&, MoveNum&) '右移

    Dim BaseStr$, Result$

    BaseStr = Oct2Bin(BaseNum)

    Debug.Print BaseStr

    MoveRight = Left(String(MoveNum, "0") & BaseStr, Len(BaseStr))

    MoveRight = Bin2Oct(MoveRight)

End Function



Function MoveLeft$(ByVal BaseNum&, MoveNum&) '左移

    Dim BaseStr$, Result$

    BaseStr = Oct2Bin(BaseNum)

    MoveLeft = Right(BaseStr & String(MoveNum, "0"), Len(BaseStr))

    MoveLeft = Bin2Oct(MoveLeft)

End Function



Function Oct2Bin$(ByVal Value&)

    Dim i&, HexValue$

    Const BinTbl = "0000000100100011010001010110011110001001101010111100110111101111"

    HexValue = CStr(Hex$(Value))

    For i = 1 To Len(HexValue)

        Oct2Bin = Oct2Bin + Mid(BinTbl, Val("&H" + Mid(HexValue, i, 1)) * 4 + 1, 4)

    Next i

End Function



Function Bin2Oct$(ByVal BinValue$)

    Dim s      As String * 4

    Dim i&

    If Len(BinValue) Mod 4 <> 0 Then

        BinValue = String(4 - Len(BinValue) Mod 4, "0") + BinValue

    End If

    For i = 1 To Len(BinValue) Step 4

        s = Mid(BinValue, i, 4) & ";"

        Bin2Oct = Bin2Oct + Mid(HexTbl, (InStr(BinTbl, s) - 1) / 5 + 1, 1)

    Next

    Bin2Oct = Val("&H" & Bin2Oct)

End Function

'示例

Private Sub Command1_Click()

    Debug.Print MoveRight(-123456, 2) '右移2位

End Sub