很久没有用VB写东西了今天突然想写个挂机程序,想起VB不能直接进行位操作,特到水木清华扒到一篇。
发信人: hermit (阿修罗～相拥我爱), 信区: VisualBasic
标 题: VB中位操作运算函数【移位指令】
发信站: BBS 水木清华站 (Sat Jun 1 12:40:23 2002)
'Module: BitPlus.Bas
'Code By Hermit @ SMTH , Jun. 1st,2000
'Email: mailtocw@sohu.com
'May these functions will help you, and
'Please keep this header if you use my code,thanks!
'提供在VB下进行位运算的函数
'SHL 逻辑左移 SHR 逻辑右移
'SAL 算术左移 SAR 算术右移
'ROL 循环左移 ROR 循环右移
'RCL 带进位循环左移 RCR 带进位循环右移
'Bin 将给定的数据转化成2进制字符串
'使用方法
'SHL SHR SAL SAR ROL ROR 基本类似，以SHL为例说明
'可以移位的变量类型，字节(Byte)，整数(Integer)，长整数(Long)
'返回值 True 移位成功， False 移位失败,当对非上述类型进行移位是会返回False
'Num 传引用变量，要移位的数据，程序会改写Num的值为运算后结果
'iCL 传值变量，要移位的次数，缺省值移位1次
'例 Dim A As Integer
' A = &H10
'如 SHL A 则移位后 A = &H20
'如 SHL A,2 则移位后 A = &H40
'如 SHL A,4 则移位后 A = &H00
'RCR与RCL类似，以RCL为例说明
'这里需要多给定一个参数，即第一次移位时的进位值iCF
'Bin举例
'A = &H1
'如 A 为字节，则 Bin(A) 返回值为 "00000001"
'如 A 为整数，则 Bin(A) 返回值为 "0000000000000001"
'如 A 为长整数，则 Bin(A) 返回值为 "00000000000000000000000000000001"
'如果传入参数非上述类型时，返回值为 ""
'更详细的信息，请参考相关汇编书籍
'逻辑左移
Public Function SHL(ByRef Num As Variant, Optional ByVal iCL As Byte = 1) As
Boolean
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 '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 = True
End Function
'逻辑右移
Public Function SHR(ByRef Num As Variant, Optional ByVal iCL As Byte = 1) As
Boolean
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
Num = (Num And &H7FFF) \ 2 Or iMask
Next
Case 3 '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 17 '8 bits
For i = 1 To iCL
bMask = 0
If (Num And &H80) <> 0 Then bMask = &H40
Num = (Num And &H7F) \ 2 Or bMask
Next
Case Else
SHR = False
Exit Function
End Select
SHR = True
End Function
'算术左移
Public Function SAL(ByRef Num As Variant, Optional ByVal iCL As Byte = 1) As
Boolean
SAL = SHL(Num, iCL)
End Function
'算术右移
Public Function SAR(ByRef Num As Variant, Optional ByVal iCL As Byte = 1) As
Boolean
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 = &HC000
Num = (Num And &H7FFF) \ 2 Or iMask
Next
Case 3 '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 = True
End Function
'循环左移
Public Function ROL(ByRef Num As Variant, Optional ByVal iCL As Byte = 1) As
Boolean
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
If (Num And &H8000) <> 0 Then iMask = iMask Or &H1
Num = (Num And &H3FFF) * 2 Or iMask
Next
Case 3 '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 = True
End Function
'循环右移
Public Function ROR(ByRef Num As Variant, Optional ByVal iCL As Byte = 1) As
Boolean
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 '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 = True
End Function
'带进位循环左移
Public Function RCL(ByRef Num As Variant, Optional ByVal iCL As Byte = 1, Op
tional ByVal iCf As Byte = 0) As Boolean
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 '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 = True
End Function
'带进位循环右移
Public Function RCR(ByRef Num As Variant, Optional ByVal iCL As Byte = 1, Op
tional ByVal iCf As Byte = 0) As Boolean
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 '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 = True
End Function
'将数值转化为二进制字符串
Public Function Bin(ByVal Num As Variant) As String
Dim tmpStr As String
Dim iMask As Long
Dim iCf As Byte, iMax As Byte
Select Case VarType(Num)
Case 2: iMax = 15 'Integer 16 bits
Case 3: iMax = 31 'Long 32 bits
Case 17: iMax = 7 'Byte 8 bits
Case Else
Bin = ""
Exit Function
End Select
iMask = 1
If iMask And Num Then
tmpStr = "1"
Else
tmpStr = "0"
End If
For iCf = 1 To iMax
If iCf = 31 Then
If Num > 0 Then
tmpStr = "0" + tmpStr
Else
tmpStr = "1" + tmpStr
End If
Exit For
End If
iMask = iMask * 2
If iMask And Num Then
tmpStr = "1" + tmpStr
Else
tmpStr = "0" + tmpStr
End If
Next
Bin = tmpStr
End Function