1、'逻辑左移Public Function SHL(ByVal Num As Variant, Optional ByVal iCL As Byte = 1) Dim i As Byte Dim bMask As Byte, iMask As Integer, lMask As Long Select Case VarType(Num) Case 2 '16 bits For i = 1 To iCL iMask = 0 If (Num And &H4000) <> 0 Then iMask = &H8000 Num = (Num And &H3FFF) * 2 Or iMask Next Case 3, 5 '32 bits For i = 1 To iCL lMask = 0 If (Num And &H40000000) <> 0 Then lMask = &H80000000 Num = (Num And &H3FFFFFFF) * 2 Or lMask Next Case 17 '8 bits For i = 1 To iCL bMask = 0 If (Num And &H40) <> 0 Then bMask = &H80 Num = (Num And &H3F) * 2 Or bMask Next Case Else SHL = False Exit Function End Select SHL = NumEnd Function
2、'逻辑右移Public Function SHR(ByVal Num As Variant, Optional ByVal iCL As Byte = 1) Dim i As Byte Dim bMask As Byte, iMask As Integer, lMask As Long a = VarType(Num) Select Case VarType(Num) Case 2 '16 bits For i = 1 To iCL iMask = 0 If (Num And &H8000) <> 0 Then iMask = &H4000 Num = (Num And &H7FFF) \ 2 Or iMask Next Case 3, 5 '32 bits For i = 1 To iCL lMask = 0 If (Num And &H80000000) <> 0 Then lMask = &H40000000 Num = (Num And &H7FFFFFFF) \ 2 Or lMask Next Case Else SHR = False Exit Function End Select SHR = NumEnd Function
3、'算术左移Public Function SAL(ByVal Num As Variant, Optional ByVal iCL As Byte = 1) SAL = SHL(Num, iCL)End Function
4、'算术右移Public Function SAR(ByVal Num As Variant, Optional ByVal iCL As Byte = 1) Dim i As Byte Dim bMask As Byte, iMask As Integer, lMask As Long a = VarType(Num) Select Case VarType(Num) Case 2 '16 bits For i = 1 To iCL iMask = 0 If (Num And &H8000) <> 0 Then iMask = &HC000 Num = (Num And &H7FFF) \ 2 Or iMask Next Case 3, 5 '32 bits For i = 1 To iCL If (Num And &H80000000) <> 0 Then lMask = &HC0000000 Num = (Num And &H7FFFFFFF) \ 2 Or lMask Next Case 17 '8 bits For i = 1 To iCL If (Num And &H80) <> 0 Then bMask = &HC0 Num = (Num And &H7F) \ 2 Or bMask Next Case Else SAR = False Exit Function End Select SAR = NumEnd Function
5、'循环左移Public Function ROL(ByVal Num As Variant, Optional ByVal iCL As Byte = 1) Dim i As Byte Dim bMask As Byte, iMask As Integer, lMask As Long a = VarType(Num) Select Case VarType(Num) Case 2 '16 bits For i = 1 To iCL iMask = 0 If (Num And &H4000) <> 0 Then iMask = &H8000 If (Num And &H8000) <> 0 Then iMask = iMask Or &H1 Num = (Num And &H3FFF) * 2 Or iMask Next Case 3, 5 '32 bits For i = 1 To iCL lMask = 0 If (Num And &H40000000) <> 0 Then lMask = &H80000000 If (Num And &H80000000) <> 0 Then lMask = lMask Or &H1 Num = (Num And &H3FFFFFFF) * 2 Or lMask Next Case 17 '8 bits For i = 1 To iCL bMask = 0 If (Num And &H40) <> 0 Then bMask = &H80 If (Num And &H80) <> 0 Then bMask = bMask Or &H1 Num = (Num And &H3F) * 2 Or bMask Next Case Else ROL = False Exit Function End Select ROL = NumEnd Function
6、'循环右移Public Function ROR(ByVal Num As Variant, Optional ByVal iCL As Byte = 1) Dim i As Byte Dim bMask As Byte, iMask As Integer, lMask As Long Select Case VarType(Num) Case 2 '16 bits For i = 1 To iCL iMask = 0 If (Num And &H8000) <> 0 Then iMask = &H4000 If (Num And &H1) <> 0 Then iMask = iMask Or &H8000 Num = (Num And &H7FFF) \ 2 Or iMask Next Case 3, 5 '32 bits For i = 1 To iCL lMask = 0 If (Num And &H80000000) <> 0 Then lMask = &H40000000 If (Num And &H1) <> 0 Then lMask = lMask Or &H80000000 Num = (Num And &H7FFFFFFF) \ 2 Or lMask Next Case 17 '8 bits For i = 1 To iCL bMask = 0 If (Num And &H80) <> 0 Then bMask = &H40 If (Num And &H1) <> 0 Then bMask = bMask Or &H80 Num = (Num And &H7F) \ 2 Or bMask Next Case Else ROR = False Exit Function End Select ROR = NumEnd Function
7、'带进位循环左移Public Function RCL(ByVal Num As Variant, Optional ByVal iCL As Byte = 1, Optional ByVal iCf As Byte = 0) Dim i As Byte, CF As Byte Dim bMask As Byte, iMask As Integer, lMask As Long CF = iCf Select Case VarType(Num) Case 2 '16 bits For i = 1 To iCL If CF = 0 Then iMask = 0 Else iMask = 1 End If If (Num And &H4000) <> 0 Then iMask = iMask Or &H8000 If (Num And &H8000) <> 0 Then CF = 1 Else CF = 0 End If Num = (Num And &H3FFF) * 2 Or iMask Next Case 3, 5 '32 bits For i = 1 To iCL If CF = 0 Then lMask = 0 Else lMask = 1 End If If (Num And &H40000000) <> 0 Then lMask = lMask Or &H80000000 If (Num And &H80000000) <> 0 Then CF = 1 Else CF = 0 End If Num = (Num And &H3FFFFFFF) * 2 Or lMask Next Case 17 '8 bits For i = 1 To iCL If CF = 0 Then bMask = 0 Else bMask = 1 End If If (Num And &H40) <> 0 Then bMask = bMask Or &H80 If (Num And &H80) <> 0 Then CF = 1 Else CF = 0 End If Num = (Num And &H3F) * 2 Or bMask Next Case Else RCL = False Exit Function End Select RCL = TrueEnd Function
8、'带进位循环右移Public Function RCR(ByVal Num As Variant, Optional ByVal iCL As Byte = 1, Optional ByVal iCf As Byte = 0) Dim i As Byte, CF As Byte Dim bMask As Byte, iMask As Integer, lMask As Long CF = iCf Select Case VarType(Num) Case 2 '16 bits For i = 1 To iCL If CF = 1 Then iMask = &H8000 Else iMask = 0 End If If (Num And &H8000) <> 0 Then iMask = iMask Or &H4000 If (Num And &H1) <> 0 Then CF = 1 Else CF = 0 End If Num = (Num And &H7FFF) \ 2 Or iMask Next Case 3, 5 '32 bits For i = 1 To iCL If CF = 1 Then lMask = &H80000000 Else lMask = 0 End If If (Num And &H80000000) <> 0 Then lMask = lMask Or &H40000000 If (Num And &H1) <> 0 Then CF = 1 Else CF = 0 End If Num = (Num And &H7FFFFFFF) \ 2 Or lMask Next Case 17 '8 bits For i = 1 To iCL If CF = 1 Then bMask = &H80 Else bMask = 0 End If If (Num And &H80) <> 0 Then bMask = bMask Or &H40 If (Num And &H1) <> 0 Then CF = 1 Else CF = 0 End If Num = (Num And &H7F) \ 2 Or bMask Next Case Else RCR = False Exit Function End Select RCR = NumEnd Function