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