输出余数的除法结果:123456789876543/987654321=124999/987405864,
输出带小数点的除法:123456789876543/987654321=124999.9997484372。
输出带小数点的除法:123456789876543/987654321=124999.9997484372。
[此贴子已经被作者于2020-2-19 06:24编辑过]
[此贴子已经被作者于2020-2-19 10:01编辑过]
Private Function zhengchuqyushu(sa As String) As String '获取余数 If InStr(sa, "/") = 0 Then zhengchuqyushu = 0 Else zhengchuqyushu = Mid(sa, InStr(sa, "/") + 1) End If End Function Private Function zhengchuqy(sa As String) As String '获取商 If InStr(sa, "/") = 0 Then zhengchuqy = sa Else zhengchuqy = Left(sa, InStr(sa, "/") - 1) End If End Function Public Function MBBC(d1 As String) As String 'kai pingfang If Len(d1) < 10 Then jss = Int(Sqr(d1)) JW = Val(d1) - (jss) ^ 2 If JW = 0 Then MBBC = jss Else MBBC = jss & "/" & JW End If Else Dim x 'shuju changdu x = Len(d1) \ 4 d2 = String(4 - Len(d1) + 4 * x, "0") & d1 Dim a() As String ReDim a(4 To 4 * x + 4) Dim b() As String ReDim b(2 To 2 * x) Dim i, j, js For i = 4 To 4 * x + 4 Step 4 a(i) = Mid(d2, i - 3, 4) js = Int(Sqr(Val(a(4) & a(8)))) JW = Val(a(4) & a(8)) - (js) ^ 2 Next j = 4 Do While j <= 2 * x jws = MPC1(JW & "0000", a(2 * j + 4)) If MBJC(Trim(jws), MbC(Trim(js), 200)) <= 0 Then b(j) = "00" Else jwc = Left(jws, Len(jws) - Len(MbC(Trim(js), 200)) + 2) \ Left(MbC(Trim(js), 200), 2) If Len(jwc) > 2 Then b(j) = 99 Else b(j) = jwc End If Do While MBJC(Trim(jws), MbC(MPC1(b(j), MbC(Trim(js), 200)), b(j))) = -1 b(j) = b(j) - 1 Loop End If JW = MPC(Trim(jws), MbC(MPC1(MbC(200, Trim(js)), b(j)), b(j))) js = MPC1(MbC(Trim(js), 100), Trim(b(j))) j = j + 2 If JW = 0 Then MBBC = js Else MBBC = js & "/" & JW End If Loop End If End Function Public Function MBJC(d1 As String, d2 As String) As String ';bijiao If Len(d1) <= 10 And Len(d2) <= 10 Then If Val(d1) > Val(d2) Then MBJC = 1 Else If Val(d1) = Val(d2) Then MBJC = 0 Else MBJC = -1 End If End If Else If Len(d1) > Len(d2) Then MBJC = 1 Else If Len(d1) < Len(d2) Then MBJC = -1 Else If Len(d1) = Len(d2) Then Dim x, Y x = Len(d1) \ 4: Y = Len(d2) \ 4 Dim a() As String, b() As String ReDim a(4 To 4 * x + 4) ReDim b(4 To 4 * Y + 4) If Val(Left(d1, Len(d1) - 4 * x)) > Val(Left(d2, Len(d2) - 4 * Y)) Then MBJC = 1 Else If Val(Left(d1, Len(d1) - 4 * x)) < Val(Left(d2, Len(d2) - 4 * Y)) Then MBJC = -1 Else For i = 4 To 4 * x Step 4 a(i) = Mid(d1, Len(d1) - i + 1, 4) b(i) = Mid(d2, Len(d2) - i + 1, 4) Next j = 4 * x Do While a(j) = b(j) And j >= 8 j = j - 4 Loop If Val(a(j)) - Val(b(j)) > 0 Then MBJC = 1 Else If Val(a(j)) - Val(b(j)) < 0 Then MBJC = -1 Else MBJC = 0 End If End If End If End If End If End If End If End If End Function Public Function MCC(d1 As String, d2 As String) As String '程序 If Len(d1) < Len(d2) Then MCC = "0" & "/" & d1 Else If Len(d1) < 9 Then MCC = Val(d1) \ Val(d2) & "/" & Val(d1) - (Val(d1) \ Val(d2)) * Val(d2) If Mid(MCC, InStr(MCC, "/") + 1) = 0 Then MCC = Left(MCC, InStr(MCC, "/") - 1) Else MCC = MCC End If Else Dim x ';fen duan changdu x = Len(d1) Dim a() As String ReDim a(1 To x) '程序 For i = 1 To x Step 1 '程序 a(i) = Mid(d1, i, 1) Next i Dim b() As String JW = 0 ReDim b(1 To x) For j = 1 To x Step 1 b(j) = Val(JW & a(j)) \ Val(d2) JW = Val(JW & a(j)) - Val(b(j)) * Val(d2) Next j For r = 1 To x If JW = 0 Then MCC = MCC & b(r) Else CJ = CJ & b(r) MCC = CJ & "/" & JW End If For i = 1 To Len(MCC) If Not Mid(MCC, i, 1) = "0" Then Exit For End If Next strtmp = Mid(MCC, i) If Len(strtmp) = 0 Then MCC = "0" Else MCC = strtmp End If Next End If End If End Function Public Function mComp(ByVal d1 As String, ByVal d2 As String) As Integer '大数比较函数,-1:d1<d2 0:d1=d2 1:d1>d2 ' mComp = Val(Left(MPC(D1, D2), 2)) ' If mComp <> 0 Then mComp = Int(mComp / Abs(mComp)) ' Exit Function Dim i As Integer, j As Integer mFormat d1 mFormat d2 i = Len(d1) j = Len(d2) mComp = 1 If i = j Then If d1 = d2 Then mComp = 0 If d1 < d2 Then mComp = -1 Else If i < j Then mComp = -1 End If End Function Public Function mFormat(d As String) As Integer '格式化数据,将数据格式化为纯数字,非数字字符替换为0,大数为负数则去掉负号并返回-1,否则返回1 Dim i As Integer, a As String, b As String a = Trim(d) d = "" mFormat = 1 If Left(a, 1) = "-" Then mFormat = -1 For i = 1 To Len(a) '本循环将大数中非数字字符用数字0代替,如-123a456=01230456 b = Mid(a, i, 1) If b >= "0" And b <= "9" Then d = d & b Else d = d & "0" End If Next For i = 1 To Len(d) If Mid(d, i, 1) > 0 Then Exit For Next d = Right(d, Len(d) + 1 - i) '消前导0,如0000123456=123456 If d = "" Then d = "0" End Function Public Function MCC1(d1 As String, d2 As String) As String '去问号 Dim ss As String, s As Integer 'MCC1 = MCC3(d1, d2) 'Exit Function '去掉这两句的单引号就会用我的大数除法,速度慢,需要300秒,注释掉后就会用题主的除法算法,20多秒可以完成 ss = MBJC(d1, d2) If Val(ss) = -1 Then MCC1 = "0" & "/" & d1 Else If Val(ss) = 0 Then MCC1 = 1 Else If Len(d1) = Len(d2) Then s = Val(Left(d1, 1)) \ Val(Left(d2, 1)) Do While MBJC(MbC(Trim(s), Trim(d2)), d1) = 1 s = s - 1 Loop If MBJC(MbC(Trim(s), Trim(d2)), d1) = 0 Then MCC1 = s Else MCC1 = s & "/" & MPC(Trim(d1), MbC(Trim(s), Trim(d2))) End If Else If Len(d2) < 9 Then MCC1 = MCC(d1, d2) Else Dim x, Y '变问号了咋 x = Len(d1): Y = Len(d2) Dim JW, jcc, jss, jcs Dim a() As String, b() As String ReDim a(1 To x) ReDim b(1 To Y) For i = 1 To x a(i) = Mid(d1, i, 1) Next For j = 1 To Y b(j) = Mid(d2, j, 1) Next jcc = Val(a(1) & a(2)) \ Val(b(1) & b(2)) jss = MbC(Trim(jcc), d2) For i1 = 1 To Y jws = jws & a(i1) Next Do While MBJC(Trim(jws), Trim(jss)) = -1 jcc = jcc - 1 jss = MbC(Trim(jcc), d2) Loop JW = MPC(Trim(jws), Trim(jss)) z = x - Y Dim c() As String ReDim c(1 To z) For s = 1 To z If MBJC(JW & a(s + Y), d2) = -1 Then c(s) = "0" Else jwc = Val(Left(JW & a(s + Y), 3)) \ Val(Left(d2, 2)) If Len(jwc) > 1 Then c(s) = "9" Else c(s) = jwc End If Do While MBJC(JW & a(s + Y), MbC(Val(c(s)), d2)) = -1 c(s) = Right(10000 + Val(c(s) - 1), 1) Loop End If JW = MPC(JW & a(s + Y), MbC(Val(c(s)), d2)) jcc = jcc & c(s) Next s If JW = 0 Then MCC1 = jcc Else MCC1 = jcc & "/" & JW End If For i = 1 To Len(MCC1) If Not Mid(MCC1, i, 1) = "0" Then Exit For Next strtmp = Mid(MCC1, i) If Len(strtmp) = 0 Then MCC1 = "0" Else MCC1 = strtmp End If End If End If End If End If End Function Public Function MCC3(ByVal d1 As String, ByVal d2 As String) As String '格式转换,将我的大数除法结果转换为题主设定的“商/余数”格式 Dim a As String, b As String a = MCC5(d1, d2) b = MPC(d1, MbC(d2, a)) If Val(b) > 0 Then a = a & "/" & b MCC3 = a End Function Public Function MCC5(ByVal d1 As String, ByVal d2 As String) As String '大数除法,d1/d2,不处理负数,参数中非数字字符按0处理 Dim i As Long, j As Long, k As Long, a As String, b As String, c As String Dim l1 As Integer, l2 As Integer, l As Integer i = mComp(d1, d2) If i < 1 Then MCC5 = i + 1 Exit Function '返回被除数小于或等于除数的商 End If MCC5 = d1 If Val(d2) < 2 Then Exit Function '如果除数为0或1则直接把被除数作为结果返回(除0不给出错误) a = "" If Len(d2) < 9 Then k = Val(d2) j = 0 For i = 1 To Len(d1) If j > 100000000 Then a = a & Int(j / k) j = j Mod k Else If a <> "" And j < k Then a = a & "0" End If j = j * 10 + Val(Mid(d1, i, 1)) Next a = a & Int(j / k) Else b = "" a = "" i = 1 While i <= Len(d1) j = Len(b) b = b & Mid(d1, i, Len(d2) + 1 - j) '多加一位是确保b>d2 j = Len(b) - j i = i + j l = 0 l1 = 0 l2 = 100 If mComp(b, d2) >= 0 Then While l2 > l1 + 1 l = Int(l2 + l1) / 2 c = MbC(d2, l) If mComp(b, c) < 0 Then l2 = l Else l1 = l End If Wend b = MPC(b, MbC(d2, l1)) If Val(Left(b, 2)) = 0 Then b = "" '获取余数 End If c = Trim(l1) If l1 = 0 Then c = "" If a <> "" Then For k = 1 To j - Len(c) a = a & "0" Next End If a = a & c Wend End If MCC5 = a End Function Public Function MbC(ByVal d1 As String, ByVal d2 As String) As String '大数乘法,d1*d2,不处理负数,参数中非数字字符按0处理 Dim i As Integer, j As Long, k As Integer, a As String, b As String, Y As String Y = "" a = "0" For i = Len(d1) To 1 Step -1 j = 0 b = "" For k = Len(d2) To 1 Step -1 j = Val(Mid(d1, i, 1)) * Val(Mid(d2, k, 1)) + j b = (j Mod 10) & b j = Int(j / 10) Next If j > 0 Then b = j & b a = MPC1(a, b & Y) Y = Y & "0" Next MbC = a End Function Public Function MPC(ByVal d1 As String, ByVal d2 As String) As String '大数减法d1-d2,如果d2>d1则交换,非法字符当字符0处理,不识别负数 Dim a As String, b As String, c As String, i As Integer If mComp(d1, d2) < 0 Then '确保被减数大于减数 MPC = MPC(d2, d1) '这里可根据需要输出负数 Exit Function End If c = "9876543210" a = "" b = "" For i = 1 To Len(d2) b = b & Mid(c, Val(Mid(d2, i, 1)) + 1, 1) '对减数按位取反 Next For i = Len(d2) + 1 To Len(d1) b = "9" + b Next b = MPC1(b, "1") '调整该减数为对应十进制补数 b = MPC1(d1, b) a = Right(b, Len(d1)) For i = 1 To Len(a) If Mid(a, i, 1) <> "0" Then Exit For Next a = Right(a, Len(a) + 1 - i) '消前导0 If a = "" Then a = "0" MPC = a End Function Public Function MPC1(ByVal d1 As String, ByVal d2 As String) As String '大数加法d1+d2,函数不识别参数的合法性,参数中有非法字符当作0处理,不识别负数 Dim l1 As Integer, l2 As Integer, j As Integer, a As Integer, b As Integer l1 = Len(d1) l2 = Len(d2) j = 0 While l1 + l2 + j > 0 a = 0 b = 0 If l1 > 0 Then a = Val(Mid(d1, l1, 1)) l1 = l1 - 1 End If If l2 > 0 Then b = Val(Mid(d2, l2, 1)) l2 = l2 - 1 End If j = a + b + j MPC1 = (j Mod 10) & MPC1 j = Int(j / 10) Wend End Function Private Function zzxc(sa As String, sb As String) As String Dim a, b, c, d, r a = Trim(sa) b = Trim(sb) If Len(a) < 10 And Len(b) < 10 Then If Val(a) > Val(b) Then c = a d = b Else c = b d = a End If Do Until Val(c) Mod Val(d) = 0 r = c Mod d c = d d = r Loop Else If MBJC(Trim(a), Trim(b)) >= 1 Then c = a d = b Else c = b d = a End If Do Until zhengchuqyushu(MCC1(Trim(c), Trim(d))) = 0 r = zhengchuqyushu(MCC1(Trim(c), Trim(d))) c = d d = r Loop End If zzxc = d End Function Private Function qniyuan(sa As String, sb As String) As String Dim n, p, a, b, c, d, r n = Trim(sa) p = Trim(sb) a = 1 b = 0 c = 0 d = 1 If Len(n) < 10 And Len(p) < 10 Then If Val(n) > Val(p) Then m = n q = p s1 = 1 Else m = p q = n s1 = 0 End If Do Until Val(m) Mod Val(q) = 0 s = m \ q r = m Mod q s1 = s1 + 1 If s1 Mod 2 = 1 Then a = a b = a * s + b c = c d = c * s + d Else b = b a = a + b * s d = d c = c + d * s End If m = q q = r Loop If Val(a + b * m) = p Then b = b a = a + b * (m - 1) d = d c = c + d * (m - 1) Else If Val(b + a * m) = p Then a = a b = b + a * m c = c d = d + c * m Else b = b a = a + b * (m - 1) d = d c = c + d * (m - 1) End If End If x = (a + b) Mod p Y = (c + d) Mod n Else If MBJC(Trim(n), Trim(p)) >= 1 Then m = n q = p s1 = 1 Else m = p q = n s1 = 0 End If Do Until zhengchuqyushu(MCC1(Trim(m), Trim(q))) = 0 s = zhengchuqy(MCC1(Trim(m), Trim(q))) r = zhengchuqyushu(MCC1(Trim(m), Trim(q))) s1 = s1 + 1 If s1 Mod 2 = 1 Then a = a b = MPC1(MbC(Trim(a), Trim(s)), Trim(b)) c = c d = MPC1(MbC(Trim(c), Trim(s)), Trim(d)) Else b = b a = MPC1(Trim(a), MbC(Trim(b), Trim(s))) d = d c = MPC1(Trim(c), MbC(Trim(d), Trim(s))) End If m = q q = r Loop If MPC1(Trim(a), MbC(Trim(b), Trim(m))) = p Then b = b a = MPC1(Trim(a), MbC(Trim(b), MPC(Trim(m), 1))) d = d c = MPC1(Trim(c), MbC(Trim(d), MPC(Trim(m), 1))) Else If MPC1(Trim(b), MbC(Trim(a), Trim(m))) = p Then a = a b = MPC1(Trim(b), MbC(Trim(a), Trim(m))) c = c d = MPC1(Trim(d), MbC(Trim(c), Trim(m))) Else b = b a = MPC1(Trim(a), MbC(Trim(b), MPC(Trim(m), 1))) d = d c = MPC1(Trim(c), MbC(Trim(d), MPC(Trim(m), 1))) End If End If Do While Left(a, 1) = "0" a = Mid(a, 2) Loop End If qniyuan = a End Function Private Function qksmimo(sa As String, sb As String, sc As String) As String Dim c, e, n, d c = Trim(sa) e = Trim(sb) n = Trim(sc) d = 1 If Len(c) < 5 And Len(e) < 5 And Len(n) < 5 Then c = Val(c): n = Val(n) Do While e > 0 If Right(e, 1) Mod 2 = 0 Then c = c * c Mod n e = e / 2 Else d = d * c Mod n e = e - 1 End If Loop Else c = c Do While MBJC(Trim(e), 1) >= 0 If Right(e, 1) Mod 2 = 0 Then c = zhengchuqyushu(MCC1(MbC(Trim(c), Trim(c)), Trim(n))) e = zhengchuqy(MCC1(Trim(e), 2)) Else d = zhengchuqyushu(MCC1(MbC(Trim(c), Trim(d)), Trim(n))) e = MPC(Trim(e), 1) End If Loop End If qksmimo = d End Function Private Function fenjieyinzi(sa As String) As String Dim x, a, b x = sa b = Int(Sqr(Val(x)) / 2) If x = 3 Or x = 2 Then a = True Else If x Mod 2 = 0 Then a = False Else For i = 3 To 2 * b + 1 Step 2 If x Mod i = 0 Then a = False Exit For Else: a = True End If Next End If End If If a = True Then fenjieyinzi = "这是素数" Else fenjieyinzi = "2*2" End If End Function Private Sub Command1_Click() Dim a, n Dim t As Double t = Timer n = Trim(Text1) If Len(n) < 6 Then Text2 = fenjieyinzi(Trim(n)) Else n1 = MPC(Trim(n), 1) a = 123 'a为明文 a1 = zzxc(Trim(n), Trim(a)) If Val(a1) > 1 Then Text2 = a1 & "*" Else c = 999 'c为公钥 Do While zzxc(Trim(n1), Trim(c)) > 1 c = Val(c - 1) Loop d = qniyuan(Trim(c), Trim(n1)) 'd为逆元为私钥 a2 = qksmimo(Trim(a), Trim(c), Trim(n)) 'a2为密文 a3 = qksmimo(Trim(a2), Trim(d), Trim(n)) If MBJC(Trim(a3), Trim(a)) = 0 Then Text2 = "这是素数有" & Len(n) & "位,用时" & Timer - t & "秒" Else Text2 = "2*2" & "用时" & Timer - t & "秒" End If End If End If End Sub Private Sub Command2_Click() Text1 = "233333333333333333333333333333333333333333333333333333" Text2 = "" End Sub Private Sub Form_Load() Command2_Click End Sub
[此贴子已经被作者于2020-2-22 09:02编辑过]