当然，c可以改为1～n1之间的其它值，尽量小一点，这样计算快，我是这样认为的。

以下是完整的代码，欢迎试用！谢谢您的帮助！有问题欢迎沟通！加了个常规判定程序，小于等于10位的都是常规法判断的，那些中文注释全变？号了，随便改了去掉？号，没有注释了，不理解的随时问我随时解释吧！长，试试能发出来不？

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 MCC1(D1 As String, D2 As String) As String '去问号
Dim ss
 ss = MBJC(D1, D2)
If ss = -1 Then
 MCC1 = "0" & "/" & D1
  Else
  If 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
    End If
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 MbC(D1 As String, D2 As String) As String '???
Dim x, Y '啥变问号了
x = Len(D1): Y = Len(D2)
Dim a() As Integer
ReDim a(1 To x + Y, 1 To Y)
Dim I, J, C1, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 0 '??λ??0
C2 = Mid$(D2, J, 1) '啥
For I = x To 1 Step -1 'D1
  C1 = Mid$(D1, I, 1) '啥
  CJ = C1 * C2 + JW '位
  c = I + J: r = Y + 1 - J
  a(c, r) = CJ Mod 10 '我弄不清了变问号改一下去掉问号而已
JW = CJ \ 10 '位
Next
a(c - 1, r) = JW
Next
Dim b() As Integer
ReDim b(1 To x + Y)
JW = 0
For I = x + Y To 1 Step -1
Bit = JW
For J = 1 To Y
  Bit = Bit + a(I, J)
Next
b(I) = Bit Mod 10
JW = Bit \ 10
Next
If b(1) > 0 Then
MbC = MbC & b(1)
Else
MbC = MbC
End If
For I = 2 To x + Y
MbC = MbC & b(I)
Next
End Function

 Public Function MPC(D1 As String, D2 As String) As String ';jianfaqi
Dim x, Y '定义长度
If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
d3 = D1
Else
D4 = D2
d3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(d3): Y = Len(D4)
Dim a() As Integer, B1() As Integer, C1() As Integer, E1() As Integer
ReDim a(1 To x)
ReDim B1(1 To Y)
ReDim C1(1 To x)
ReDim E1(1 To x)
Dim I, J, C2, CJ, JW
For J = Y To 1 Step -1 ';D2
JW = 1 ';yu jie weichuzhi
B1(J) = Mid(D4, J, 1) ';?λ??
For I = x To 1 Step -1  ';D1
   a(I) = Mid(d3, I, 1) ';?λ??
   C1(I) = 10 + a(I) - B1(I) - 1 + JW ';????jia
   JW = C1(I) \ 10
   E1(I) = C1(I) Mod 10
  Next
  Next
  For r = 1 To x
  MPC = MPC & E1(r)
  For I = 1 To Len(MPC)
    If Not Mid(MPC, I, 1) = "0" Then
        Exit For
    End If
Next
strtmp = Mid(MPC, I)
  If Len(strtmp) = 0 Then
  MPC = "0"
  Else
MPC = strtmp
End If
  Next
  
  
End Function
  Public Function MPC1(D1 As String, D2 As String) As String 'jiafa
Dim x, Y '????????

If Len(D1) >= Len(D2) Then
D4 = String(Len(D1) - Len(D2), "0") & D2
d3 = D1
Else
D4 = D2
d3 = String(Len(D2) - Len(D1), "0") & D1
End If
x = Len(d3): Y = Len(D4)
Dim a() As Integer, B1() As Integer, C1() As Integer, E1() As Integer
ReDim a(1 To x)
ReDim B1(1 To Y)
ReDim C1(1 To x)
ReDim E1(1 To x)
Dim I, J, C2, CJ, JW
For J = Y To 1 Step -1 'D2
JW = 0 '??λ??0
B1(J) = Mid$(D4, J, 1) '?λ??
For I = x To 1 Step -1  'D1
   a(I) = Mid$(d3, I, 1) '?λ??
   C1(I) = a(I) + B1(I) + JW '????jia
   JW = C1(I) \ 10
   E1(I) = C1(I) Mod 10
  Next
  Next
  For r = 1 To x
  If JW = 0 Then
  MPC1 = MPC1 & E1(r)
  Else
  jc = jc & E1(r)
  MPC1 = JW & jc
  End If
  Next
  
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 Right(X, 1) Mod 2 = 0 Then
a = False
Else

For I = 3 To 2 * B + 1 Step 2
If InStr(X / 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
n = Trim(Text1)
If Len(n) < 11 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) & "位"
Else
Text2 = "2*2"
End If
End If
End If
End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""

End Sub

[此贴子已经被作者于2021-9-14 21:47编辑过]

嗯，理论上是可以的，这样做别人解密也是so easy。
当初做RSA时对什么欧拉函数、费马大定理等也是狠狠啃过的，代码通过后就扔了。我现在对什么扩展欧几里得算法求乘法逆元都搞不清楚是啥玩意了，好像是假设n-1、d互质，可以找到一个因子e让式子e*d-e*(e*d mod (n-1))=1成立吧，这个因子e就是用于解密的私匙。
有空再啃啃。
做RSA加解密的基础是大数的加减乘除和取余，我记得当初做时，为了提高运算速度，充分利用了cpu的运算能力，都在16进制下运算，比那种纯数字字符串大数运算的效率高，除法使用了二分法求商，效率也还可以。至于那种用分治法的快速乘法算法我也不会弄，有空去学习下。
如果代码太多，你可以只提供你的大数运算代码，我看看有改进优化的空间没有。

对，一般是e为公钥，d为私钥，e，d互为逆元，都能用，反过来也成立。

二分法求商的除法程序请你给我发一下！我的除法慢，效率低，仿手工计算的。
我的大数运算程序都在上面了，都是可调用程序，已经完整了，可以直接复制代码运行试验了。
欢迎试验！
欢迎帮助指导！谢谢指教！

是e*d mod  (n-1) =1.这就是e叫d的乘法逆元，或叫e模(n-1)的逆元为d，e和d互为逆元，可以互推的，上面的可调用程序qniyuan()就可以求出来，输入e和(n-1)，输出d.

MPC1()为大数加法，MPC()为大数的减法，MbC( )为大数的乘法，MCC1()为大数的除法，
MCC( )为除数少于8位的大数的除法，MBBC( )为大数开平方。
这些程序您有快速的效果好的都可以发过来！请教了，向您学习学习！谢谢！

凡是合数程序输出结果都是2*2或3*，有个*号，凡是素数程序输出结果都是这是素数。
程序只做判断，不分解因数。

我们的设计理念不一样，在c里我是把2^32当作一位做运算，你是按十进制位做运算，效率肯定低，不过仍有改进优化空间，我试着按你的思路改进下，要花点时间。

好，谢谢！期待好的程序！您慢慢弄，不行的话，请把你的二分法求商值的除法程序发一下！
谢谢您！