Public Function ArrMUL(ByRef Num1() As Long, ByRef Num2() As Long) As Long() '乘法
Dim LNum1 As Long
Dim LNum2 As Long
Dim Tmp As Long
Dim Ans() As Long
Dim Result() As Long
Dim i As Long
Dim j As Long
LNum1 = UBound(Num1)
LNum2 = UBound(Num2)
Tmp = LNum1 + LNum2 + 1
ReDim Ans(Tmp)
For i = 0 To LNum1
For j = 0 To LNum2
Ans(i + j) = Ans(i + j) + Num1(i) * Num2(j)
If Ans(i + j) >= &H1000 Then
Ans(i + j + 1) = Ans(i + j + 1) + Int(Ans(i + j) / &H1000)
Ans(i + j) = Ans(i + j) Mod &H1000
End If
Next
Next
i = UBound(Ans)
If i <> 0 Then
For j = i To 1 Step -1
If Ans(j) <> 0 Then Exit For
Next
Else
j = 0
End If
ReDim Result(j)
i = LongToLong(Ans(), Result(), j)
ArrMUL = Result
End Function
Public Function ArrDIV(ByRef Num1() As Long, ByRef Num2() As Long, ModResult() As Long) As Long() '除法
Dim LNum1 As Long
Dim LNum2 As Long
Dim Ans() As Long
Dim TNum1() As Long
Dim Result() As Long
Dim i As Long
Dim kk As Long
Dim Tmp() As Long
Dim Tmp2() As Long
LNum2 = UBound(Num2)
ReDim Ans(0)
Ans(0) = 0
Do While kk = 0
If Tmp(0) = 0 And LNum1 <> 0 Then
Tmp(0) = Int((TNum1(LNum1) * &H1000 + TNum1(LNum1 - 1)) / (Num2(LNum2) + 1))
LNum1 = LNum1 - 1
ElseIf Tmp(0) = 0 And LNum1 = 0 Then
Tmp(0) = Int(TNum1(LNum1) * &H1000 / (Num2(LNum2) + 1))
LNum1 = LNum1 - 1
End If
If LNum1 - LNum2 <> -1 Then
Tmp() = ArrShl(Tmp(), LNum1 - LNum2)
Else
Tmp(0) = 1
End If
Ans() = ArrADC(Ans(), Tmp())
Loop
LNum1 = UBound(Ans)
If LNum1 <> 0 Then
For i = LNum1 To 1 Step -1
If Ans(i) <> 0 Then Exit For
Next
Else
i = 0
End If
ReDim Result(i)
kk = LongToLong(Ans(), Result(), i)
ModResult() = TNum1
ArrDIV = Result
End Function
Public Function ArrShl(Num() As Long, n As Long) As Long() '左位移
Dim i As Long, Result() As Long
ReDim Result(UBound(Num) + n)
For i = 0 To UBound(Num)
Result(i + n) = Num(i)
Next i
ArrShl = Result
End Function
Public Function ArrShr(Num() As Long, n As Long) As Long() '右位移
Dim i As Long, Result() As Long
ReDim Result(UBound(Num) - n)
For i = 0 To UBound(Num)
Result(i - n) = Num(i)
Next i
ArrShr = Result
End Function
Public Function ArrMutMod(ByRef Num1() As Long, ByRef Num2() As Long, ByRef ModNum() As Long) As Long() '模乘
Dim Num() As Long
Dim Result() As Long
ArrDIV ArrMUL(Num1(), Num2()), ModNum(), Result()
ArrMutMod = Result
End Function
Public Function ArrMiMod(ByRef Num1() As Long, ByRef NumT() As Long, ByRef ModNum() As Long) As Long() '模幂
Dim Numb0() As Long
Dim Numb1() As Long
Dim Numb2() As Long
Dim e() As Long
Dim c() As Long
Dim d() As Long
Dim TmpNum() As Long
e = NumT
c = Num1
ReDim d(0)
d(0) = 1
Do While ArrMt(e, Numb0)
If e(0) Mod 2 = 0 Then
c() = ArrMutMod(c(), c(), ModNum())
e = ArrDIV(e, Numb2, TmpNum())
Else
d() = ArrMutMod(d(), c(), ModNum())
e = ArrSBB(e, Numb1)
End If
Loop
ArrMiMod = d
End Function
Public Function LongToLong(ByRef Num1() As Long, Num2() As Long, ByVal L1 As Long) As Long
Dim i As Long
For i = 0 To L1
Num2(i) = Num1(i)
Next
End Function
Private Function ArrMt(ByRef Num1() As Long, Num2() As Long) As Boolean
Dim LNum1 As Long
Dim LNum2 As Long
Dim i As Long
LNum1 = UBound(Num1)
LNum2 = UBound(Num2)
If LNum1 > LNum2 Then
ArrMt = True
ElseIf LNum2 > LNum1 Then
ArrMt = False
Else
For i = LNum1 To 0 Step -1
If Num1(i) > Num2(i) Then
ArrMt = True
Exit For
ElseIf Num1(i) < Num2(i) Then
ArrMt = False
Exit For
End If
Next
End If
End Function
Private Function ArrIs0(ByRef Num1() As Long) As Boolean
If UBound(Num1) = 0 And Num1(0) = 0 Then
ArrIs0 = True
Else
ArrIs0 = False
End If
End Function
Public Function ArrDelSpace(Num() As Long) As Boolean
Dim i As Long, MaxArr As Long
For i = UBound(Num) To 0 Step -1
If Num(i) > &H0 Then
MaxArr = i
Exit For
End If
Next i
ReDim Preserve Num(MaxArr)
End Function
Public Function HexToArr(ByVal Str As String) As Long()
Dim LNum As Long
Dim i As Long
Dim Str2 As String
Dim ReStr() As Long
LNum = Len(Str) Mod 3
If LNum = 0 Then
Str2 = Str
Else
Str2 = String(3 - LNum, "0") & Str
End If
LNum = Len(Str2) / 3
ReDim ReStr(LNum - 1)
For i = 0 To LNum - 1
ReStr(i) = Val("&H" & Mid(Str2, LNum * 3 - i * 3 - 2, 3) & "&")
Next
HexToArr = ReStr()
End Function
Public Function ArrToHex(ByRef Num() As Long) As String
Dim LNum As Long
Dim i As Long
Dim s As String
Dim Ans As String
LNum = UBound(Num) - 1
For i = 0 To LNum
s = Hex(Num(i))
s = String(3 - Len(s), "0") & s
Ans = s & Ans
Next
Ans = Hex(Num(LNum + 1)) & Ans
ArrToHex = Ans
End Function
Function StrDIV(Num1 As String, Num2 As String, ModNum As String) As String '除法运算
Dim Result As String, ResultByte() As Long, MaxResult As Long
Dim i As Long, j As Long, fi As Long, TempNum As String, TempModNum As String
Dim LengthOfNum1 As Long, LengthOfNum2 As Long
DelSpace Num1
DelSpace Num2
If Num1 = "0" Or Num2 = "0" Then
ModNum = "0"
Exit Function
End If
If StrLt(Num1, Num2) = True Then
ModNum = Num1
Exit Function
'StrSwap Num1, Num2 '如果Num1小于Num2,交换位置
End If
LengthOfNum1 = Len(Num1): LengthOfNum2 = Len(Num2) '取得数据长度
ReDim ResultByte(1 To LengthOfNum1 - LengthOfNum2 + 1) As Long
fi = LengthOfNum1 - LengthOfNum2 + 1
TempNum = Left(Num1, LengthOfNum2) '取得前LengthOfNum2位
For i = LengthOfNum2 To LengthOfNum1 '进行运算
If i > LengthOfNum2 Then TempNum = TempNum & Mid(Num1, i, 1) '增加一位
If StrLt(TempNum, Num2) = False Then '如果TempNum不小于Num2
For j = 2 To 10 '进行测试
If StrMt(StrXLng(Num2, j), TempNum) = True Then '直到Num2 * j大于TempNum为止
ResultByte(fi) = j - 1 '输出最终结果到ResultByte(fi)
TempNum = StrSBB(TempNum, StrXLng(Num2, ResultByte(fi))) '取得余数
Exit For
End If
Next j
End If
fi = fi - 1
Next i
MaxResult = UBound(ResultByte)
For i = UBound(ResultByte) To 1 Step -1 '去掉前面多余的零
If ResultByte(i) = 0 Then MaxResult = MaxResult - 1 Else Exit For
Next i
For i = 1 To MaxResult '输出结果
Result = CStr(ResultByte(i)) + Result
Next i
If Trim$(TempNum) <> "" Then ModNum = TempNum Else ModNum = "0"
If Trim$(Result) <> "" Then StrDIV = Result Else StrDIV = "0"
End Function
Public Function StrXLng(Num1 As String, Num2 As Long) As String '进行Long变量和String变量的混合乘法运算(速度有提升)
Dim Result As String, ResultByte() As Long, MaxResult As Long
Dim i As Long, TempByte As Long, TempHighByte As Long
Dim NumByte1() As Long
Dim LengthOfNum1 As Long
LengthOfNum1 = Len(Num1) '取得数据长度
ReDim NumByte1(1 To LengthOfNum1) As Long
ReDim ResultByte(1 To LengthOfNum1 + 1) As Long
j = LengthOfNum1
For i = 1 To LengthOfNum1 '将数据逆向保存到数组中
NumByte1(i) = Mid(Num1, j, 1)
j = j - 1
Next i
For i = 1 To LengthOfNum1 '进行运算
TempByte = NumByte1(i) * Num2 '各位进行乘法运算
If TempByte < &HA Then '如果小于10
ResultByte(i) = ResultByte(i) + TempByte '直接输出到ResultByte(fi)中
Else '否则
TempHighByte = TempByte \ 10 '计算进位的多少
ResultByte(i) = ResultByte(i) + TempByte - TempHighByte * 10 '计算个位
ResultByte(i + 1) = ResultByte(i + 1) + TempHighByte '向上进位
End If
If ResultByte(i) > &H9 Then '如果ResultByte(fi)大于10
TempHighByte = ResultByte(i) \ 10 '输出进位的多少
ResultByte(i) = ResultByte(i) - TempHighByte * 10 '计算个位
ResultByte(i + 1) = ResultByte(i + 1) + TempHighByte '向上进位
End If
Next i
MaxResult = UBound(ResultByte)
For i = UBound(ResultByte) To 1 Step -1 '去掉前面多余的零
If ResultByte(i) = 0 Then MaxResult = MaxResult - 1 Else Exit For
Next i
For i = 1 To MaxResult '输出结果
Result = CStr(ResultByte(i)) + Result
Next i
StrXLng = Result
End Function
Function StrHex2Dec(HexStr As String) As String
Dim Result As String, TempStr As String
Dim LengthOfHex As Long, i As Long, j As Long, HexBytes() As String
LengthOfHex = Len(HexStr)
ReDim HexBytes(1 To LengthOfHex)
ReDim DecBytes(1 To LengthOfHex + 1)
For j = LengthOfHex To 1 Step -1
i = i + 1
Select Case Mid(HexStr, j, 1)
Case "F"
HexBytes(i) = "15"
Case "E"
HexBytes(i) = "14"
Case "D"
HexBytes(i) = "13"
Case "C"
HexBytes(i) = "12"
Case "B"
HexBytes(i) = "11"
Case "A"
HexBytes(i) = "10"
Case "9"
HexBytes(i) = "9"
Case "8"
HexBytes(i) = "8"
Case "7"
HexBytes(i) = "7"
Case "6"
HexBytes(i) = "6"
Case "5"
HexBytes(i) = "5"
Case "4"
HexBytes(i) = "4"
Case "3"
HexBytes(i) = "3"
Case "2"
HexBytes(i) = "2"
Case "1"
HexBytes(i) = "1"
Case "0"
HexBytes(i) = "0"
End Select
Next j
Result = "0"
For i = 1 To LengthOfHex
TempStr = HexBytes(i)
For j = 2 To i
TempStr = StrMUL(TempStr, "16")
Next j
Result = StrADC(TempStr, Result)
Next i
If Trim$(Result) <> "" Then StrHex2Dec = Result Else StrHex2Dec = "0"
End Function
Function DelSpace(Num As String) As Boolean
Dim i As Long
For i = 1 To Len(Num)
If Left(Num, 1) = "0" Then Num = Right(Num, Len(Num) - 1) Else Exit For
Next i
DelSpace = True
End Function
Public Function ArrADC(ByRef Num1() As Long, ByRef Num2() As Long) As Long() '加法
Dim Ans() As Long
Dim LNum1 As Long
Dim LNum2 As Long
Dim TNum1() As Long
Dim TNum2() As Long
Dim Result() As Long
Dim i As Long
Dim j As Long
Dim kk As Long
Dim IsN As Boolean
LNum1 = UBound(Num1)
LNum2 = UBound(Num2)
If LNum1 > LNum2 Then
i = LNum1
ReDim TNum2(i)
TNum1() = Num1
kk = LongToLong(Num2(), TNum2(), LNum2)
Else
i = LNum2
ReDim TNum1(i)
kk = LongToLong(Num1(), TNum1(), LNum1)
TNum2() = Num2
End If
ReDim Ans(i)
For j = 0 To i
Ans(j) = TNum1(j) + TNum2(j)
If IsN = True Then Ans(j) = Ans(j) + 1
If Ans(j) >= &H1000 Then
Ans(j) = Ans(j) - &H1000
IsN = True
Else
IsN = False
End If
Next
If IsN = True Then
ReDim Result(i + 1)
Result(i + 1) = 1
kk = LongToLong(Ans(), Result(), i)
Else
ReDim Result(i)
Result() = Ans
End If
ArrADC = Result
End Function
Public Function ArrSBB(ByRef Num1() As Long, ByRef Num2() As Long) As Long() '减法
Dim Ans() As Long
Dim LNum1 As Long
Dim LNum2 As Long
Dim TNum1() As Long
Dim TNum2() As Long
Dim Result() As Long
Dim i As Long
Dim j As Long
Dim kk As Long
Dim IsN As Boolean
LNum1 = UBound(Num1)
LNum2 = UBound(Num2)
If ArrMt(Num1(), Num2()) = True Then
i = LNum1
ReDim TNum2(i)
TNum1() = Num1
kk = LongToLong(Num2(), TNum2(), LNum2)
Else
i = LNum2
ReDim TNum2(i)
TNum1() = Num2
kk = LongToLong(Num1(), TNum2(), LNum1)
End If
ReDim Ans(i)
For j = 0 To i
Ans(j) = TNum1(j) - TNum2(j)
If IsN = True Then Ans(j) = Ans(j) - 1
If Ans(j) < 0 Then
Ans(j) = Ans(j) + &H1000
IsN = True
Else
IsN = False
End If
Next
i = UBound(Ans)
If i <> 0 Then
For j = i To 1 Step -1
If Ans(j) <> 0 Then Exit For
Next
Else
j = 0
End If
ReDim Result(j)
kk = LongToLong(Ans(), Result(), j)
ArrSBB = Result
End Function
Function StrADC(Num1 As String, Num2 As String) As String '加法运算
Dim Result As String, ResultByte() As Long, MaxResult As Long
Dim i As Long, j As Long, TempByte As Long
Dim NumByte1() As Long, NumByte2() As Long
Dim LengthOfNum1 As Long, LengthOfNum2 As Long
DelSpace Num1
DelSpace Num2
If Trim(Num1) = "" Then Num1 = "0"
If Trim(Num2) = "" Then Num2 = "0"
LengthOfNum1 = Len(Num1): LengthOfNum2 = Len(Num2) '取得数据长度
ReDim NumByte1(1 To LengthOfNum1) As Long
ReDim NumByte2(1 To LengthOfNum2) As Long
ReDim ResultByte(1 To IIf(LengthOfNum1 > LengthOfNum2, LengthOfNum1 + 1, LengthOfNum2 + 1)) As Long
j = LengthOfNum1
For i = 1 To LengthOfNum1 '将数据逆向保存到数组中
NumByte1(i) = Mid(Num1, j, 1)
j = j - 1
Next i
j = LengthOfNum2
For i = 1 To LengthOfNum2 '同上
NumByte2(i) = Mid(Num2, j, 1)
j = j - 1
Next i
For i = 1 To UBound(ResultByte) - 1 '进行运算
If (i <= LengthOfNum2) And (i <= LengthOfNum1) Then
TempByte = NumByte1(i) + NumByte2(i) + ResultByte(i) '各个数位进行加法运算
ElseIf (i <= LengthOfNum2) Then
TempByte = NumByte2(i) + ResultByte(i) '同上
ElseIf (i <= LengthOfNum1) Then
TempByte = NumByte1(i) + ResultByte(i) '同上
End If
If TempByte < &HA Then '如果TempByte小于10
ResultByte(i) = TempByte '直接输出TempByte到保存最终结果的数组
Else '否则
ResultByte(i) = TempByte - 10 '将TempByte减去10再保存到最终结果
ResultByte(i + 1) = 1 '进位1
End If
Next i
MaxResult = UBound(ResultByte)
For i = UBound(ResultByte) To 1 Step -1 '去掉前面多余的零
If ResultByte(i) = 0 Then MaxResult = MaxResult - 1 Else Exit For
Next i
For i = 1 To MaxResult '输出结果
Result = CStr(ResultByte(i)) + Result
Next i
StrADC = Result
End Function
Function StrLt(Num1 As String, Num2 As String) As Boolean
'如果Num1小于Num2,输出结果True,否则输出结果False
Dim LengthOfNum1 As Long, LengthOfNum2 As Long
Dim i As Long
Dim NumByte1 As Long, NumByte2 As Long
DelSpace Num1
DelSpace Num2
LengthOfNum1 = Len(Num1): LengthOfNum2 = Len(Num2)
If LengthOfNum1 > LengthOfNum2 Then '进行长度比较
StrLt = False
ElseIf LengthOfNum1 < LengthOfNum2 Then '同上
StrLt = True
Else '如果长度相等
For i = 1 To LengthOfNum1 '逐位进行比较
NumByte1 = Mid(Num1, i, 1)
NumByte2 = Mid(Num2, i, 1)
If NumByte1 <> NumByte2 Then '如果不相等
If NumByte1 < NumByte2 Then StrLt = True '且Num1的那位小于Num2的那位,输出True
Exit For '不管是否为True,都退出循环
End If
Next i
End If
End Function
Function StrMt(Num1 As String, Num2 As String) As Boolean
'如果Num1大于Num2,输出结果True,否则输出结果False
Dim LengthOfNum1 As Long, LengthOfNum2 As Long
Dim i As Long
Dim NumByte1 As Long, NumByte2 As Long
DelSpace Num1
DelSpace Num2
If Trim(Num1) = "" Then Num1 = "0"
If Trim(Num2) = "" Then Num2 = "0"
LengthOfNum1 = Len(Num1): LengthOfNum2 = Len(Num2)
If LengthOfNum1 < LengthOfNum2 Then '进行长度比较
StrMt = False
ElseIf LengthOfNum1 > LengthOfNum2 Then '同上
StrMt = True
Else
For i = 1 To LengthOfNum1 '逐位进行比较
NumByte1 = Mid(Num1, i, 1)
NumByte2 = Mid(Num2, i, 1)
If NumByte1 <> NumByte2 Then '如果不相等
If NumByte1 > NumByte2 Then StrMt = True '且Num1的那位大于Num2的那位,输出Ture
Exit For '不管是否为True,都退出循环
End If
Next i
End If
End Function
Function StrSwap(Num1 As String, Num2 As String) As Boolean
'进行数据的交换
Dim ChangeNum As String
ChangeNum = Num1
Num1 = Num2
Num2 = ChangeNum
StrSwap = True
End Function
Function StrSBB(Num1 As String, Num2 As String) As String '减法运算
Dim Result As String, ResultByte() As Long, MaxResult As Long
Dim i As Long, j As Long, TempByte As Long
Dim NumByte1() As Long, NumByte2() As Long
Dim LengthOfNum1 As Long, LengthOfNum2 As Long
DelSpace Num1
DelSpace Num2
If Trim(Num1) = "" Then Num1 = "0"
If Trim(Num2) = "" Then Num2 = "0"
If StrLt(Num1, Num2) = True Then StrSwap Num1, Num2 '如果Num1小于Num2,交换位置
LengthOfNum1 = Len(Num1): LengthOfNum2 = Len(Num2) '取得数据长度
ReDim NumByte1(1 To LengthOfNum1) As Long
ReDim NumByte2(1 To LengthOfNum2) As Long
ReDim ResultByte(1 To LengthOfNum1) As Long
j = LengthOfNum1
For i = 1 To LengthOfNum1 '将数据逆向保存到数组中
NumByte1(i) = Mid(Num1, j, 1)
j = j - 1
Next i
j = LengthOfNum2
For i = 1 To LengthOfNum2 '同上
NumByte2(i) = Mid(Num2, j, 1)
j = j - 1
Next i
For i = 1 To UBound(ResultByte) '进行运算
If i <= LengthOfNum2 Then
TempByte = NumByte1(i) - NumByte2(i) '各个数位进行加法运算
If TempByte < &H0 Then '如果小于0了
TempByte = TempByte + 10 '加上10
NumByte1(i + 1) = NumByte1(i + 1) - 1 '向上借一位
End If
Else
TempByte = NumByte1(i)
End If
ResultByte(i) = TempByte '输出TempByte到保存最终结果的数组
Next i
MaxResult = UBound(ResultByte)
For i = UBound(ResultByte) To 1 Step -1 '去掉前面多余的零
If ResultByte(i) = 0 Then MaxResult = MaxResult - 1 Else Exit For
Next i
For i = 1 To MaxResult '输出结果
Result = CStr(ResultByte(i)) + Result
Next i
StrSBB = Result
End Function
Function StrMUL(Num1 As String, Num2 As String) As String '乘法运算
Dim Result As String, ResultByte() As Long, MaxResult As Long
Dim i As Long, j As Long, fi As Long, TempByte As Long, TempHighByte As Long
Dim NumByte1() As Long, NumByte2() As Long
Dim LengthOfNum1 As Long, LengthOfNum2 As Long
DelSpace Num1
DelSpace Num2
If Trim(Num1) = "" Then Num1 = "0"
If Trim(Num2) = "" Then Num2 = "0"
LengthOfNum1 = Len(Num1): LengthOfNum2 = Len(Num2) '取得数据长度
ReDim NumByte1(1 To LengthOfNum1) As Long
ReDim NumByte2(1 To LengthOfNum2) As Long
ReDim ResultByte(1 To LengthOfNum1 + LengthOfNum2) As Long
j = LengthOfNum1
For i = 1 To LengthOfNum1 '将数据逆向保存到数组中
NumByte1(i) = Mid(Num1, j, 1)
j = j - 1
Next i
j = LengthOfNum2
For i = 1 To LengthOfNum2 '同上
NumByte2(i) = Mid(Num2, j, 1)
j = j - 1
Next i
For i = 1 To LengthOfNum1 '进行运算
For j = 1 To LengthOfNum2
TempByte = NumByte1(i) * NumByte2(j) '各位进行乘法运算
fi = i + j - 1 '计算偏移位
If TempByte < &HA Then '如果小于10
ResultByte(fi) = ResultByte(fi) + TempByte '直接输出到ResultByte(fi)中
Else '否则
TempHighByte = TempByte \ 10 '计算进位的多少
ResultByte(fi) = ResultByte(fi) + TempByte - TempHighByte * 10 '计算个位
ResultByte(fi + 1) = ResultByte(fi + 1) + TempHighByte '向上进位
End If
If ResultByte(fi) > &H9 Then '如果ResultByte(fi)大于10
TempHighByte = ResultByte(fi) \ 10 '输出进位的多少
ResultByte(fi) = ResultByte(fi) - TempHighByte * 10 '计算个位
ResultByte(fi + 1) = ResultByte(fi + 1) + TempHighByte '向上进位
End If
Next j
Next i
MaxResult = UBound(ResultByte)
For i = UBound(ResultByte) To 1 Step -1 '去掉前面多余的零
If ResultByte(i) = 0 Then MaxResult = MaxResult - 1 Else Exit For
Next i
For i = 1 To MaxResult '输出结果
Result = CStr(ResultByte(i)) + Result
Next i
If Trim$(Result) <> "" Then StrMUL = Result Else StrMUL = "0"
End Function