Code:
Sub MAIN()
TestSHA3Functions
End Sub
Sub TestSHA3Functions()
' Create a new test
Dim SHATestTxt As String
SHATestTxt = "Cc123456"
MsgBox SHA3_224(SHATestTxt) & vbCrLf & "The correct value should be：" & vbCrLf & "4d9a9b213f1518cb46243b5676365b08312d57eeb124874b16767697"
'正确值应
End Sub
Function SHA3_224(msg As String, Optional opt As Dictionary) As String
'Hash224
'Generates 224-bit SHA-3 / Keccak hash of message.
'String msg - String to be hashed (Unicode-safe).
'Dictionary options - padding: sha-3 / keccak; msgFormat: string / hex; outFormat: hex / hex-b / hex-w.
SHA3_224 = Keccak1600(1152, 448, msg, opt)
End Function
Function Keccak1600(R As Integer, C As Integer, msg As String, Optional opt As Dictionary) As String
'Generates SHA-3 / Keccak hash of message M.
'Integer r - Bitrate 'r' (b-c)
'Integer c - Capacity 'c' (b-r), md length ?2
'String msg - Message
'Dictionary options - padding: sha-3 / keccak; msgFormat: string / hex; outFormat: hex / hex-b / hex-w.
'{string} Hash as hex-encoded string.
'const defaults = { padding: 'sha-3', msgFormat: 'string', outFormat: 'hex' };
Set OptDefaults = New Scripting.Dictionary
OptDefaults.Add "padding", "sha-3"
OptDefaults.Add "msgFormat", "string"
OptDefaults.Add "outFormat", "hex"
If opt Is Nothing Then Set opt = New Scripting.Dictionary
For Each k In OptDefaults.Keys
If Not opt.Exists(k) Then
opt.Add k, OptDefaults(k)
End If
Next k
MsgLen = C / 2
' message digest output length in bits
'
If opt("msgFormat") = "hex-bytes" Then
'NOT IMPLEMENTED YET, hexBytesToString(M)
'msg = StrConv(msg, vbUnicode)
Else
'utf8Encode(M)
'msg = StrConv(msg, vbUnicode)
End If
'2d array
Dim state(0 To 4, 0 To 4, 0 To 1) As Currency
Dim squeezeState(0 To 4, 0 To 4) As String
' last dimension: 0 = lo, 1 = hi
' * Keccak state is a 5 ?5 x w array of bits (w=64 for keccak-f[1600] / SHA-3).
' * Here, it is implemented as a 5 ?5 array of Long. The first subscript (x) defines the
' * sheet, the second (y) defines the plane, together they define a lane. Slices, columns,
' * and individual bits are obtained by bit operations on the hi,lo components of the Long
' * representing the lane.
q = (R / 8) - Len(msg) Mod (R / 8)
If q = 1 Then
If opt("padding") = "keccak" Then
msg = msg & Chr$(129)
Else
msg = msg & Chr$(134)
End If
Else
If opt("padding") = "keccak" Then
msg = msg & Chr$(1)
Else
msg = msg & Chr$(6)
End If
msg = msg & String(q - 2, Chr$(0))
msg = msg & Chr$(128)
End If
'Debug.Print "q", q, Len(msg), msg,
w = 64 'for keccak-f[1600]
blocksize = R / w * 8
'Debug.Print w, blocksize
i = 0
Do While i < Len(msg)
j = 0
Do While j < R / w
lo = LeftShift(CLng(Asc(Mid(msg, i + j * 8 + 0 + 1, 1))), 0, 32) + _
LeftShift(CLng(Asc(Mid(msg, i + j * 8 + 1 + 1, 1))), 8, 32) + _
LeftShift(CLng(Asc(Mid(msg, i + j * 8 + 2 + 1, 1))), 16, 32) + _
LeftShift(CLng(Asc(Mid(msg, i + j * 8 + 3 + 1, 1))), 24, 32)
hi = LeftShift(CLng(Asc(Mid(msg, i + j * 8 + 4 + 1, 1))), 0, 32) + _
LeftShift(CLng(Asc(Mid(msg, i + j * 8 + 5 + 1, 1))), 8, 32) + _
LeftShift(CLng(Asc(Mid(msg, i + j * 8 + 6 + 1, 1))), 16, 32) + _
LeftShift(CLng(Asc(Mid(msg, i + j * 8 + 7 + 1, 1))), 24, 32)
x = j Mod 5
y = Int(j / 5)
'Debug.Print "x,y lo,hi ", i & "," & j & " " & lo & "," & hi
state(x, y, 0) = state(x, y, 0) Xor lo
state(x, y, 1) = state(x, y, 1) Xor hi
j = j + 1
Loop
newstate = keccak_f_1600(state)
i = i + blocksize
Loop
'Squeeze state
For i = 0 To 4
For j = 0 To 4
v1 = state(i, j, 0)
v2 = state(i, j, 1)
If v1 >= 2 ^ (32 - 1) Then v1 = v1 - 2 ^ (32)
If v2 >= 2 ^ (32 - 1) Then v2 = v2 - 2 ^ (32)
s1 = Hex(v1)
s2 = Hex(v2)
If Len(s1) < 8 Then s1 = String$(8 - Len(s1), "0") & s1
If Len(s2) < 8 Then s2 = String$(8 - Len(s2), "0") & s2
squeezeState(i, j) = LCase(s2 & s1)
'Debug.Print i, j, squeezeState(i, j)
Next j
Next i
ResStr = ""
For j = 0 To 4
For i = 0 To 4
For k = 8 To 1 Step -1
ResStr = ResStr & Mid(squeezeState(i, j), 2 * k - 1, 2)
Next k
'Debug.Print ResStr
Next i
Next j
Keccak1600 = Left(ResStr, MsgLen / 4)
'// if required, group message digest into bytes or words
'if (opt.outFormat == 'hex-b') md = md.match(/.{2}/g).join(' ');
'if (opt.outFormat == 'hex-w') md = md.match(/.{8,16}/g).join(' ');
'Debug.Print "END HERE!"
'550b320103b1f401"
'550b32013b1f401
'b87f88c72702fff1748e58b87e9141a42c0dbedc29a78cb0d4a5cd81a96abded
'b87f88c72702fff1748e58b87e9141a42c0dbedc29a78cb0d4a5cd81a96abded52f214ef4fb788ba
End Function
Function keccak_f_1600(StateIn)
nRounds = 24
'2d array
Dim RCs
RCs = Array("0000000000000001", "0000000000008082", "800000000000808a", "8000000080008000", "000000000000808b", "0000000080000001", _
"8000000080008081", "8000000000008009", "000000000000008a", "0000000000000088", "0000000080008009", "000000008000000a", _
"000000008000808b", "800000000000008b", "8000000000008089", "8000000000008003", "8000000000008002", "8000000000000080", _
"000000000000800a", "800000008000000a", "8000000080008081", "8000000000008080", "0000000080000001", "8000000080008008")
Dim RC(0 To 23, 0 To 1) As Currency
For R = 0 To UBound(RCs)
RC(R, 0) = HexToDec_C(Right(RCs(R), 8))
RC(R, 1) = HexToDec_C(Left(RCs(R), 8))
'Put data back into Long range, as shifts are binary
If RC(R, 0) >= 2 ^ (32 - 1) Then RC(R, 0) = RC(R, 0) - 2 ^ (32)
If RC(R, 1) >= 2 ^ (32 - 1) Then RC(R, 1) = RC(R, 1) - 2 ^ (32)
'Debug.Print "hi " & RC(R, 1) & " lo " & RC(R, 0)
Next R
'// Keccak-f permutations
For R = 0 To nRounds - 1
'Debug.Print "r:" & R
'Debug.Print "Keccak 2.3.2"
'Debug.Print StateIn(0, 0, 0), StateIn(0, 0, 1)
Dim C(0 To 4, 0 To 1) As Currency
For x = 0 To 4
C(x, 0) = StateIn(x, 0, 0)
C(x, 1) = StateIn(x, 0, 1)
For y = 1 To 4
'Debug.Print "xy chi " & x & y & " " & C(x, 1)
'Debug.Print "xy clo " & x & y & " " & C(x, 0)
C(x, 1) = Xor_C(C(x, 1), StateIn(x, y, 1))
C(x, 0) = Xor_C(C(x, 0), StateIn(x, y, 0))
Next y
Next x
'Debug.Print "Keccak 2.3.2 bis"
'Debug.Print StateIn(0, 0, 0), StateIn(0, 0, 1)
For x = 0 To 4
'Debug.Print "D hi- " & x & " " & C((x + 4) Mod 5, 1)
'Debug.Print "D lo- " & x & " " & C((x + 4) Mod 5, 0)
Dim Rt(0 To 1) As Currency
Rt(0) = C((x + 1) Mod 5, 0)
Rt(1) = C((x + 1) Mod 5, 1)
Rr = rotl(Rt, 1)
'Debug.Print "D rot hi- " & x & " " & Rr(1)
'Debug.Print "D rot lo- " & x & " " & Rr(0)
hi = Xor_C(C((x + 4) Mod 5, 1), Rr(1))
lo = Xor_C(C((x + 4) Mod 5, 0), Rr(0))
Dim D(0 To 4, 0 To 1) As Currency
D(x, 1) = hi
D(x, 0) = lo
For y = 0 To 4
StateIn(x, y, 1) = Xor_C(StateIn(x, y, 1), D(x, 1))
StateIn(x, y, 0) = Xor_C(StateIn(x, y, 0), D(x, 0))
Next y
Next x
'Debug.Print "Keccak 2.3.4"
'Debug.Print StateIn(0, 0, 0), StateIn(0, 0, 1)
xa = 1
ya = 0
Dim tmp(0 To 1) As Currency
Dim cur(0 To 1) As Currency
'ReDim Rt(0 To 1) As Long
cur(0) = StateIn(xa, ya, 0)
cur(1) = StateIn(xa, ya, 1)
For t = 0 To 23
xb = ya
yb = (2 * xa + 3 * ya) Mod 5
'Debug.Print t, xb, yb
tmp(0) = StateIn(xb, yb, 0)
tmp(1) = StateIn(xb, yb, 1)
Rr = rotl(cur, ((t + 1) * (t + 2) / 2) Mod 64)
StateIn(xb, yb, 0) = Rr(0)
StateIn(xb, yb, 1) = Rr(1)
cur(0) = tmp(0)
cur(1) = tmp(1)
xa = xb
ya = yb
Next t
'Debug.Print "Keccak 2.3.1"
'Debug.Print StateIn(0, 0, 0), StateIn(0, 0, 1)
For y = 0 To 4
Erase C
For x = 0 To 4
C(x, 0) = StateIn(x, y, 0)
C(x, 1) = StateIn(x, y, 1)
Next x
For x = 0 To 4
StateIn(x, y, 1) = RightShiftZF(Xor_C(C(x, 1), And_C(Not_C(C((x + 1) Mod 5, 1)), C((x + 2) Mod 5, 1))), 0)
StateIn(x, y, 0) = RightShiftZF(Xor_C(C(x, 0), And_C(Not_C(C((x + 1) Mod 5, 0)), C((x + 2) Mod 5, 0))), 0)
'StateIn(x, y, 1) = RightShiftZF(C(x, 1) Xor ((Not C((x + 1) Mod 5, 1) And C((x + 2) Mod 5, 1))), 0)
'StateIn(x, y, 0) = RightShiftZF(C(x, 0) Xor ((Not C((x + 1) Mod 5, 0) And C((x + 2) Mod 5, 0))), 0)
Next x
Next y
'Debug.Print "Keccak 2.3.5"
'Debug.Print StateIn(0, 0, 0), StateIn(0, 0, 1)
'Debug.Print "a00-lo1:", StateIn(0, 0, 0), DecToBin_C(StateIn(0, 0, 0), 32)
'Debug.Print "RCr-lo1:", RC(R, 0), DecToBin_C(StateIn(0, 0, 0), 32)
StateIn(0, 0, 1) = RightShiftZF(Xor_C(StateIn(0, 0, 1), RC(R, 1)), 0)
StateIn(0, 0, 0) = RightShiftZF(Xor_C(StateIn(0, 0, 0), RC(R, 0)), 0)
'Debug.Print "a00-lo2:", StateIn(0, 0, 0), DecToBin_C(StateIn(0, 0, 0), 32)
Next R
End Function
Function rotl(ObjIn() As Currency, n As Byte) As Currency()
'Debug.Print "ROTL data: ", ObjIn(0), ObjIn(1), n
Dim m As Byte
'Rotate left
Dim R(0 To 1) As Currency
If n < 32 Then
m = 32 - n
lo_1 = LeftShift(ObjIn(0), n, 32)
lo_2 = RightShiftZF(ObjIn(1), m, 32)
hi_1 = LeftShift(ObjIn(1), n, 32)
hi_2 = RightShiftZF(ObjIn(0), m, 32)
lo = lo_1 Or lo_2
hi = hi_1 Or hi_2
' const lo = this.lo<<n | this.hi>>>m;
' const hi = this.hi<<n | this.lo>>>m;
R(0) = lo
R(1) = hi
ElseIf n = 32 Then
R(0) = ObjIn(0)
R(1) = ObjIn(1)
ElseIf n > 32 Then
n = n - 32
m = 32 - n
lo_1 = LeftShift(ObjIn(1), n, 32)
lo_2 = RightShiftZF(ObjIn(0), m, 32)
hi_1 = LeftShift(ObjIn(0), n, 32)
hi_2 = RightShiftZF(ObjIn(1), m, 32)
lo = lo_1 Or lo_2
hi = hi_1 Or hi_2
' const lo = this.hi<<n | this.lo>>>m;
' const hi = this.lo<<n | this.hi>>>m;
R(0) = lo
R(1) = hi
End If
rotl = R()
End FunctionCode:
'INSPRIRED BY:
'https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Operators/Bitwise_Operators
'https://www.mrexcel.com/forum/excel-questions/578667-use-dec2bin-function-vba-edit-macro.html
'https://vbaf1.com/variables/data-types/
Function DecToBin_C(DecimalIn As Variant, OutputLen As Byte, Optional IsSigned As Boolean = True) As String
'need_DecToBin_C
If IsSigned Then
'Signed value in, e.g. len = 16 -> -32,768 to 32,767
MinDecVal = CDec(-2 ^ (OutputLen - 1))
MaxDecVal = CDec(2 ^ (OutputLen - 1) - 1)
Else
'Unsigned value in, e.g. len = 16 -> 0 to 65535
MinDecVal = CDec(0)
MaxDecVal = CDec(2 ^ OutputLen - 1)
End If
DecToBin2 = ""
DecCalc = CDec(DecimalIn)
If DecCalc < MinDecVal Or DecCalc > MaxDecVal Then
'Error (6) 'overflow -> error normally off, giving back an empty string, but can switch it on
DecToBin_C = DecToBin2
Exit Function
End If
Do While DecimalIn <> 0
DecToBin2 = Trim$(Str$(DecCalc - 2 * Int(DecCalc / 2))) & DecToBin2
DecCalc = Int(DecCalc / 2)
'Escape for maximum length (negative numbers):
If Len(DecToBin2) = OutputLen Then Exit Do
Loop
DecToBin_C = Right$(String$(OutputLen, "0") & DecToBin2, OutputLen)
End Function
Function BinToDec_C(StringIn As String, Optional IsSigned As Boolean = True) As Variant
'need_BinToDec_C
'Input assumed to be a Signed number, otherwise use IsSigned = False
Dim StrLen As Byte
StrLen = Len(StringIn)
BinToDec_C = 0
If Left(StringIn, 1) = "1" And IsSigned Then
'negative number, signed
For i = 1 To Len(StringIn)
If Mid(StringIn, StrLen + 1 - i, 1) = "0" Then
BinToDec_C = BinToDec_C + 2 ^ (i - 1)
End If
Next i
BinToDec_C = -BinToDec_C - 1
Else
'positive number, can be signed or unsigned
For i = 1 To Len(StringIn)
If Mid(StringIn, StrLen + 1 - i, 1) = "1" Then
BinToDec_C = BinToDec_C + 2 ^ (i - 1)
End If
Next i
End If
End Function
Function LeftShift(ValIn As Variant, Shift As Byte, Optional DefaultLen As Byte = 1, Optional IsSigned As Boolean = True) As Variant
'need LeftShift
'<< Zero fill left shift - Shifts left by pushing zeros in from the right and let the leftmost bits fall off
If DefaultLen = 1 Then
' DefaultLen -> will get the most appropriate value of 8 (byte), 16 (integer), 32 (long), 64 (longlong)
DefaultLen = GetDefaultLen(ValIn, IsSigned)
End If
Dim TempStr As String
TempStr = DecToBin_C(ValIn, DefaultLen, IsSigned)
TempStr = Right$(TempStr & String$(Shift, "0"), DefaultLen)
LeftShift = BinToDec_C(TempStr, IsSigned)
End Function
Function RightShiftZF(ValIn As Variant, Shift As Byte, Optional DefaultLen As Byte = 1, Optional IsSigned As Boolean = True) As Variant
'need_RightShiftZF
'>>> Zero fill right shift Shifts right by pushing zeros in from the left, and let the rightmost bits fall off
'Also called: Unsigned Right Shift [>>>]
If DefaultLen = 1 Then
' DefaultLen -> will get the most appropriate value of 8 (byte), 16 (integer), 32 (long), 64 (longlong)
DefaultLen = GetDefaultLen(ValIn, IsSigned)
End If
Dim TempStr As String
TempStr = DecToBin_C(ValIn, DefaultLen, IsSigned)
TempStr = Left$(String$(Shift, "0") & TempStr, DefaultLen)
RightShiftZF = BinToDec_C(TempStr, IsSigned)
End Function
Function HexToDec_C(hexString As String) As Variant
'need_HexToDec_C
'https://stackoverflow.com/questions/40213758/convert-hex-string-to-unsigned-int-vba#40217566
'cut off "&h" if present
If Left(hexString, 2) = "&h" Or Left(hexString, 2) = "&H" Then hexString = Mid(hexString, 3)
'cut off leading zeros
While Left(hexString, 1) = "0"
hexString = Mid(hexString, 2)
Wend
If hexString = "" Then hexString = "0"
HexToDec_C = CDec("&h" & hexString)
'correct value for 8 digits onle
'Debug.Print hexString, HexToDec_C
If HexToDec_C < 0 And Len(hexString) = 8 Then
HexToDec_C = CDec("&h1" & hexString) - 4294967296#
'cause overflow for 16 digits
ElseIf HexToDec_C < 0 Then
Error (6) 'overflow
End If
End Function
Function GetDefaultLen(ValIn As Variant, IsSigned As Boolean) As Byte
'need_GetDefaultLen
If IsSigned Then
'Signed value in, e.g. len = 16 -> -32,768 to 32,767
If CDec(ValIn) >= -2 ^ (8 - 1) And CDec(ValIn) <= 2 ^ (8 - 1) - 1 Then
GetDefaultLen = 8 '8 (byte)
ElseIf CDec(ValIn) >= -2 ^ (16 - 1) And CDec(ValIn) <= 2 ^ (16 - 1) - 1 Then
GetDefaultLen = 16 '16 (integer)
ElseIf CDec(ValIn) >= -2 ^ (32 - 1) And CDec(ValIn) <= 2 ^ (32 - 1) - 1 Then
GetDefaultLen = 32 '32 (long)
ElseIf CDec(ValIn) >= -2 ^ (64 - 1) And CDec(ValIn) <= 2 ^ (64 - 1) - 1 Then
GetDefaultLen = 64 '64 (longlong)
Else
'Number too big for function, return max value that Currency can represent
GetDefaultLen = 96
End If
Else
'Unsigned value in, e.g. len = 8 -> 0 to 255
If CDec(ValIn) <= 2 ^ 8 - 1 And CDec(ValIn) >= 0 Then
GetDefaultLen = 8 '8 (byte)
ElseIf CDec(ValIn) <= 2 ^ 16 - 1 And CDec(ValIn) >= 0 Then
GetDefaultLen = 16 '16 (integer)
ElseIf CDec(ValIn) <= 2 ^ 32 - 1 And CDec(ValIn) >= 0 Then
GetDefaultLen = 32 '32 (long)
ElseIf CDec(ValIn) <= 2 ^ 64 - 1 And CDec(ValIn) >= 0 Then
GetDefaultLen = 64 '64 (longlong)
Else
'Number too big for function, return max value that Currency can represent
GetDefaultLen = 96
End If
End If
End Function
Function Not_C(ValIn1 As Variant, Optional IsSigned As Boolean = True) As Variant
'need_Not_C
Dim s3 As String
Dim s1len As Byte
d1 = CDec(ValIn1)
UseDefault = True
If IsSigned = True Then
If d1 < -2 ^ (32 - 1) Or d1 > 2 ^ (32 - 1) - 1 Then UseDefault = False
Else
UseDefault = False
End If
If UseDefault Then
Not_C = Not ValIn1
Else
'Check size and sign
s1len = GetDefaultLen(d1, IsSigned)
s1 = DecToBin_C(d1, s1len, IsSigned)
s3 = ""
For C = 1 To s1len
If Mid(s1, C, 1) = "1" Then
s3 = s3 & "0"
Else
s3 = s3 & "1"
End If
Next C
Not_C = BinToDec_C(s3, IsSigned)
End If
End Function
Function And_C(ValIn1 As Variant, ValIn2 As Variant, Optional IsSigned As Boolean = True) As Variant
'need_And_C
And_C = OrAndXor_C("AND", ValIn1, ValIn2, IsSigned)
End Function
Function Xor_C(ValIn1 As Variant, ValIn2 As Variant, Optional IsSigned As Boolean = True) As Variant
'need_Xor_C
Xor_C = OrAndXor_C("XOR", ValIn1, ValIn2, IsSigned)
End Function
Function OrAndXor_C(Func As String, ValIn1 As Variant, ValIn2 As Variant, Optional IsSigned As Boolean = True) As Variant
'need_OrAndXor_C
Dim s3 As String
Dim maxlen As Byte
d1 = CDec(ValIn1)
d2 = CDec(ValIn2)
Func = LCase(Func)
UseDefault = True
If IsSigned = True Then
If d1 < -2 ^ (32 - 1) Or d1 > 2 ^ (32 - 1) - 1 Then UseDefault = False
If d2 < -2 ^ (32 - 1) Or d2 > 2 ^ (32 - 1) - 1 Then UseDefault = False
Else
UseDefault = False
End If
If UseDefault Then
If Func = "xor" Then
OrAndXor_C = d1 Xor d2
ElseIf Func = "or" Then
OrAndXor_C = d1 Or d2
ElseIf Func = "and" Then
OrAndXor_C = d1 And d2
Else
OrAndXor_C = False
End If
Else
If IsSigned Then
'Too big for a 32 bit long, go for 64 bit
s1 = DecToBin_C(d1, 64)
s2 = DecToBin_C(d2, 64)
s3 = ""
For C = 1 To 64
If Func = "xor" Then
If Mid(s1, C, 1) = Mid(s2, C, 1) Then
s3 = s3 & "0"
Else
s3 = s3 & "1"
End If
ElseIf Func = "or" Then
If Mid(s1, C, 1) = 1 Or Mid(s2, C, 1) = 1 Then
s3 = s3 & "1"
Else
s3 = s3 & "0"
End If
ElseIf Func = "and" Then
If Mid(s1, C, 1) = 1 And Mid(s2, C, 1) = 1 Then
s3 = s3 & "1"
Else
s3 = s3 & "0"
End If
End If
Next C
OrAndXor_C = BinToDec_C(s3)
Else
'Treat as unsigned
s1len = GetDefaultLen(d1, False)
s2len = GetDefaultLen(d2, False)
If s1len > s2len Then maxlen = s1len Else maxlen = s2len
s1 = DecToBin_C(d1, maxlen, False)
s2 = DecToBin_C(d2, maxlen, False)
s3 = ""
For C = 1 To maxlen
If Func = "xor" Then
If Mid(s1, C, 1) = Mid(s2, C, 1) Then
s3 = s3 & "0"
Else
s3 = s3 & "1"
End If
ElseIf Func = "or" Then
If Mid(s1, C, 1) = 1 Or Mid(s2, C, 1) = 1 Then
s3 = s3 & "1"
Else
s3 = s3 & "0"
End If
ElseIf Func = "and" Then
If Mid(s1, C, 1) = 1 And Mid(s2, C, 1) = 1 Then
s3 = s3 & "1"
Else
s3 = s3 & "0"
End If
End If
Next C
OrAndXor_C = BinToDec_C(s3, False)
End If
End If
End Function
Function Or_C(ValIn1 As Variant, ValIn2 As Variant, Optional IsSigned As Boolean = True) As Variant
'不需要
Or_C = OrAndXor_C("OR", ValIn1, ValIn2, IsSigned)
End Function
Function RightShift(ValIn As Variant, Shift As Byte, Optional DefaultLen As Byte = 1, Optional IsSigned As Boolean = True) As Variant
'不需要
'>> Signed right shift Shifts right by pushing copies of the leftmost bit in from the left, and let the rightmost bits fall off
'Also called: Signed Right Shift [>>]
If DefaultLen = 1 Then
' DefaultLen -> will get the most appropriate value of 8 (byte), 16 (integer), 32 (long), 64 (longlong)
DefaultLen = GetDefaultLen(ValIn, IsSigned)
End If
Dim TempStr As String
Dim FillStr As String
TempStr = DecToBin_C(ValIn, DefaultLen, IsSigned)
FillStr = Left(TempStr, 1)
TempStr = Left$(String$(Shift, FillStr) & TempStr, DefaultLen)
RightShift = BinToDec_C(TempStr, IsSigned)
End Function