按键内存位移运算

作者： @a ＊磕巴   　 这个加进我的内存汇编库更加强大。

Function Class_Bit()

  Class_Bit = "Class Bit" & vbCrLf &_

"dim bitLength, bitLengthSub, opBit"  & vbCrLf &_

"dim bits, bitsSub, bitsSubNot"  & vbCrLf &_

"dim DEFAULT_BIT_LENGTH" & vbCrLf &_

"Private Sub Class_Initialize()" & vbCrLf &_

"DEFAULT_BIT_LENGTH = 32" & vbCrLf &_

  "Call setBit(32)" & vbCrLf &_

"End Sub" & vbCrLf &_

"Private Sub Class_Terminate()" & vbCrLf &_

"End Sub"  & vbCrLf &_

  "Public Sub setBit(ByVal n) " & vbCrLf &_

  "    '设置位长" & vbCrLf &_

  "    If n = 32 Then " & vbCrLf &_

  "        bitLength = &H20& " & vbCrLf &_

  "        bitLengthSub = &H1F& " & vbCrLf &_

  "        opBit = &H80000000& " & vbCrLf &_

  "   bits = Array(&H00000001&, &H00000002&, &H00000004&, &H00000008&, &H00000010&, &H00000020&, &H00000040&, &H00000080&, &H00000100&, &H00000200&, &H00000400&, &H00000800&, &H00001000&, &H00002000&, &H00004000&, &H00008000&, &H00010000&, &H00020000&, &H00040000&, &H00080000&, &H00100000&, &H00200000&, &H00400000&, &H00800000&, &H01000000&, &H02000000&, &H04000000&, &H08000000&, &H10000000&, &H20000000&, &H40000000&, &H80000000&) " & vbCrLf &_

"bitsSub = Array(&H00000000&, &H00000001&, &H00000003&, &H00000007&, &H0000000F&, &H0000001F&, &H0000003F&, &H0000007F&, &H000000FF&, &H000001FF&, &H000003FF&, &H000007FF&, &H00000FFF&, &H00001FFF&, &H00003FFF&, &H00007FFF&, &H0000FFFF&, &H0001FFFF&, &H0003FFFF&, &H0007FFFF&, &H000FFFFF&, &H001FFFFF&, &H003FFFFF&, &H007FFFFF&, &H00FFFFFF&, &H01FFFFFF&, &H03FFFFFF&, &H07FFFFFF&, &H0FFFFFFF&, &H1FFFFFFF&, &H3FFFFFFF&, &H7FFFFFFF&, &HFFFFFFFF&) " & vbCrLf &_

"bitsSubNot = array(&HFFFFFFFF&,&HFFFFFFFE&,&HFFFFFFFC&,&HFFFFFFF8&,&HFFFFFFF0&,&HFFFFFFE0&,&HFFFFFFC0&,&HFFFFFF80&,&HFFFFFF00&,&HFFFFFE00&,&HFFFFFC00&,&HFFFFF800&,&HFFFFF000&,&HFFFFE000&,&HFFFFC000&,&HFFFF8000&,&HFFFF0000&,&HFFFE0000&,&HFFFC0000&,&HFFF80000&,&HFFF00000&,&HFFE00000&,&HFFC00000&,&HFF800000&,&HFF000000&,&HFE000000&,&HFC000000&,&HF8000000&,&HF0000000&,&HE0000000&,&HC0000000&,&H80000000&) " & vbCrLf &_

  "    ElseIf n = 16 Then " & vbCrLf &_

  "        bitLength = &H10 " & vbCrLf &_

  "        bitLengthSub = &HF " & vbCrLf &_

  "        opBit = &H8000 " & vbCrLf &_

  "        bits = Array(&H0001, &H0002, &H0004, &H0008, &H0010, &H0020, &H0040, &H0080, &H0100, &H0200, &H0400, &H0800, &H1000, &H2000, &H4000, &H8000) " & vbCrLf &_

  "        bitsSub = Array(&H0000, &H0001, &H0003, &H0007, &H000F, &H001F, &H003F, &H007F, &H00FF, &H01FF, &H03FF, &H07FF, &H0FFF, &H1FFF, &H3FFF, &H7FFF, &HFFFF) " & vbCrLf &_

  "        bitsSubNot = Array(&HFFFF, &HFFFE, &HFFFC, &HFFF8, &HFFF0, &HFFE0, &HFFC0, &HFF80, &HFF00, &HFE00, &HFC00, &HF800, &HF000, &HE000, &HC000, &H8000) " & vbCrLf &_

  "    End If " & vbCrLf &_

  "End Sub " & vbCrLf &_

  "Public Function getBit() " & vbCrLf &_

  "    getBit = bitLength " & vbCrLf &_

  "End Function " & vbCrLf &_

  "Public Function sal(ByVal value, ByVal offset) " & vbCrLf &_

  "    '算术左移  " & vbCrLf &_

  "    offset = offset and bitLengthSub " & vbCrLf &_

  "    If value and bits(bitLengthSub - offset) Then " & vbCrLf &_

  "        sal = (value and bitsSub(bitLengthSub - offset)) * bits(offset) or opBit " & vbCrLf &_

  "    Else " & vbCrLf &_

  "        sal = (value and bitsSub(bitLengthSub - offset)) * bits(offset) " & vbCrLf &_

  "    End If " & vbCrLf &_

  "End Function " & vbCrLf &_

  "Public Function sar(ByVal value, ByVal offset) " & vbCrLf &_

  "    '算术右移 " & vbCrLf &_

  "    offset = offset and bitLengthSub " & vbCrLf &_

  "    if offset = bitLengthSub then " & vbCrLf &_

  "        'sar = (not (value and bitsSubNot(offset)) \ bits(offset) ) + bits(0)  " & vbCrLf &_

  "        sar = - (value and bitsSubNot(offset) \ bits(offset)) " & vbCrLf &_

  "    else " & vbCrLf &_

  "        sar = (value and bitsSubNot(offset)) \ bits(offset)  " & vbCrLf &_

  "    end if " & vbCrLf &_

  "End Function " & vbCrLf &_

  "Public Function shr(ByVal value, ByVal offset) " & vbCrLf &_

  "    '逻辑右移 " & vbCrLf &_

  "    offset = offset and bitLengthSub " & vbCrLf &_

  "    shr = (value and bitsSubNot(offset)) \ bits(offset) and bitsSub(bitLength - offset) " & vbCrLf &_

  "End Function " & vbCrLf &_

  "Public Function rol(ByVal value, ByVal offset) " & vbCrLf &_

  "    '循环左移 " & vbCrLf &_

  "    Dim coverOffset " & vbCrLf &_

  "    offset = offset and bitLengthSub " & vbCrLf &_

  "    coverOffset = (bitLength - offset and bitLengthSub) " & vbCrLf &_

  "    If value and bits(bitLengthSub - offset) Then " & vbCrLf &_

  "        rol = ((value and bitsSub(bitLengthSub - offset)) * bits(offset) or opBit) or ((value and bitsSubNot(coverOffset)) \ bits(coverOffset) and bitsSub(bitLength - coverOffset)) " & vbCrLf &_

  "    Else " & vbCrLf &_

  "        rol = ((value and bitsSub(bitLengthSub - offset)) * bits(offset)) or ((value and bitsSubNot(coverOffset)) \ bits(coverOffset) and bitsSub(bitLength - coverOffset)) " & vbCrLf &_

  "    End If " & vbCrLf &_

  "End Function " & vbCrLf &_

  "Public Function ror(ByVal value, ByVal offset) " & vbCrLf &_

  "    '循环右移  " & vbCrLf &_

  "    Dim coverOffset " & vbCrLf &_

  "    offset = offset and bitLengthSub " & vbCrLf &_

  "    coverOffset = (bitLength - offset and bitLengthSub) " & vbCrLf &_

  "    If value and bits(bitLengthSub - coverOffset) Then " & vbCrLf &_

  "        ror = ((value and bitsSub(bitLengthSub - coverOffset)) * bits(coverOffset) or opBit) or ((value and bitsSubNot(offset)) \ bits(offset) and bitsSub(bitLength - offset)) " & vbCrLf &_

  "    Else " & vbCrLf &_

  "        ror = ((value and bitsSub(bitLengthSub - coverOffset)) * bits(coverOffset)) or ((value and bitsSubNot(offset)) \ bits(offset) and bitsSub(bitLength - offset)) " & vbCrLf &_

  "    End If " & vbCrLf &_

  "End Function " & vbCrLf &_

  "Public Function binary(ByVal value)" & vbCrLf &_

  "    '十进制转二进制  " & vbCrLf &_

"    Dim result, i" & vbCrLf &_

"    Do" & vbCrLf &_

"        result = (value and bits(0)) & result" & vbCrLf &_

"        value = (value and bitsSubNot(1)) \ bits(1) and bitsSub(bitLength - 1)" & vbCrLf &_

"    Loop While value <> 0" & vbCrLf &_

"    binary = result" & vbCrLf &_

"End Function" & vbCrLf &_

"Public Function formatBinary(ByVal s)" & vbCrLf &_

"    '格式化二进制" & vbCrLf &_

"    Dim result,i" & vbCrLf &_

"    s = Right(String(bitLength, ""0"") & s, bitLength)" & vbCrLf &_

"    For i = 1 To bitLengthSub Step 4" & vbCrLf &_

"        result = result & mid(s, i, 4) & "" """ & vbCrLf &_

"    Next" & vbCrLf &_

"    formatBinary = Left(result, bitLength + bitLength \ 4 - 1)" & vbCrLf &_

"End Function" & vbCrLf &_

"Public Function binaryToDecimal(ByVal s)" & vbCrLf &_

"    '二进制转十进制" & vbCrLf &_

"    Dim value,i" & vbCrLf &_

"    value = value or bitsSub(0)" & vbCrLf &_

"    For i = 1 To len(s)" & vbCrLf &_

"        If value and bits(bitLengthSub - 1) Then" & vbCrLf &_

"            value = (value and bitsSub(bitLengthSub - 1)) * bits(1) or opBit or cint(mid(s, i, 1))" & vbCrLf &_

"        Else " & vbCrLf &_

"            value = (value and bitsSub(bitLengthSub - 1)) * bits(1) or cint(mid(s, i, 1))" & vbCrLf &_

"        End If" & vbCrLf &_

"    Next" & vbCrLf &_

"    binaryToDecimal = value" & vbCrLf &_

"End Function" & vbCrLf &_

"End Class" & vbCrLf &_

  ""

End Function

Sub SaveClassCode(path)

  Dim fso, f

  Set fso = CreateObject("Scripting.FileSystemObject")

  Set f = fso.OpenTextFile(path, 2, True)

  f.Write Class_Bit()

End Sub

Execute Class_Bit()

Dim b

Set b = New Bit

bin = b.binary(-1)

TracePrint bin

TracePrint b.formatBinary(bin)

TracePrint b.binaryToDecimal("1111111111111111")

b.setBit 16

bin = b.binary(-1)

TracePrint bin

TracePrint b.formatBinary(bin)

TracePrint b.binaryToDecimal("1111111111111111")