输出余数的除法结果: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编辑过]
