按键内存位移运算491
发表时间:2018-04-09 11:38 作者: @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") |