VB位运算模块

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)


'--------向左位移全局函数--------
Public Function LeftBitMove(ByVal Number As Long, ByVal MoveValue As Long) As Long


On Error GoTo Err


Dim i As Long
Dim TextLen As Long
Dim MoveText As String
Dim TempText As String
Dim MoveNumber As Long
Dim MoveData(0 To 3) As Byte


LeftBitMove = 0


If MoveValue <= 0 Or MoveValue >= 32 Then GoTo Err


MoveNumber = Number
Call CopyMemory(MoveData(0), MoveNumber, 4)


MoveText = ""


For i = LBound(MoveData) To UBound(MoveData)
  MoveText = DecimalToBinary(MoveData(i)) & MoveText
Next i


MoveText = MoveText & String(MoveValue, "0")


TextLen = Len(MoveText)
If TextLen > 32 Then MoveText = Right(MoveText, 32)
TextLen = Len(MoveText)
If TextLen < 32 Then MoveText = String(32 - TextLen, "0") + MoveText


For i = LBound(MoveData) To UBound(MoveData)
  MoveData(UBound(MoveData) - i) = BinaryToDecimal(Mid(MoveText, (i * 8) + 1, 8))
Next i


MoveText = ""


For i = LBound(MoveData) To UBound(MoveData)
  TempText = Hex(MoveData(i))
  TextLen = Len(TempText)
  If TextLen < 2 Then TempText = String(2 - TextLen, "0") + TempText
  MoveText = TempText & MoveText
Next i


MoveText = "&H" & MoveText


LeftBitMove = Val(MoveText)


Exit Function


Err:
LeftBitMove = Number


End Function


'--------向右位移全局函数--------
Public Function RightBitMove(ByVal Number As Long, ByVal MoveValue As Long) As Long


On Error GoTo Err


Dim i As Long
Dim TextLen As Long
Dim MoveText As String
Dim TempText As String
Dim MoveNumber As Long
Dim MoveData(0 To 3) As Byte


RightBitMove = 0


If MoveValue <= 0 Or MoveValue >= 32 Then GoTo Err


MoveNumber = Number
Call CopyMemory(MoveData(0), MoveNumber, 4)


MoveText = ""


For i = LBound(MoveData) To UBound(MoveData)
  MoveText = DecimalToBinary(MoveData(i)) & MoveText
Next i


MoveText = Left(MoveText, 32 - MoveValue)


TextLen = Len(MoveText)
If TextLen > 32 Then MoveText = Right(MoveText, 32)
TextLen = Len(MoveText)
If TextLen < 32 Then MoveText = String(32 - TextLen, "0") + MoveText


For i = LBound(MoveData) To UBound(MoveData)
  MoveData(UBound(MoveData) - i) = BinaryToDecimal(Mid(MoveText, (i * 8) + 1, 8))
Next i


MoveText = ""


For i = LBound(MoveData) To UBound(MoveData)
  TempText = Hex(MoveData(i))
  TextLen = Len(TempText)
  If TextLen < 2 Then TempText = String(2 - TextLen, "0") + TempText
  MoveText = TempText & MoveText
Next i


MoveText = "&H" & MoveText


RightBitMove = Val(MoveText)


Exit Function


Err:
RightBitMove = Number


End Function


Private Function BinaryToDecimal(Data As String) As Byte


On Error Resume Next


Dim i As Long
Dim TreatData As String
Dim DecimalNumber As Byte


TreatData = Right(Data, 8)


DecimalNumber = 0


For i = 1 To Len(TreatData)
  DecimalNumber = DecimalNumber + (Val(Mid(TreatData, i, 1)) * (2 ^ (Len(TreatData) - i)))
Next i


BinaryToDecimal = DecimalNumber


End Function


Private Function DecimalToBinary(ByVal Data As Byte) As String


On Error Resume Next


Dim TextLen As Long
Dim ExtraNumber As Byte
Dim TreatNumber As Byte
Dim BinaryText As String


TreatNumber = Data


Do While TreatNumber > 0
  ExtraNumber = TreatNumber Mod 2
  TreatNumber = Fix(TreatNumber / 2)
  BinaryText = CStr(ExtraNumber) & BinaryText
Loop


TextLen = Len(BinaryText)
If TextLen > 8 Then BinaryText = Right(BinaryText, 32)
TextLen = Len(BinaryText)
If TextLen < 8 Then BinaryText = String(8 - TextLen, "0") + BinaryText


DecimalToBinary = BinaryText


End Function