几个vb小程序

ysr

76545051729020975577310162521900618820659871603466655644272117978380005723696097587725184512638784526308634214455061267843403507870735540391292521535824647434568377082591826884769598224146796862139607-  76545051729020975577310162521900618820659871603466655644272117978380005723696097587725184512638784526308634214455061267843403507870735540391292521535824647434568377082591826884769598224146796816367616

=45771991

ysr

45771991=4729*9679不是素数，而是个合数。
45771991~45772091之间的素数有8个：（用时1.757813E-02秒）
45772003  45772009  45772033  45772037  45772039  45772057  45772061  45772087  
其中有一对孪生素数就是45772037  45772039

ysr

Public Function tuzis(sa As String) As String 'tuzi shulie
Dim A, B, c
A = Val(sa)
B = 1
B1 = 0
b2 = 1
b3 = 0
Do While B <= A
B1 = b2

s1 = s1 & "/" & Trim(b3)

b2 = b3
b3 = MPC1(Trim(B1), Trim(b2))


B = Val(B + 1)

Loop
tuzis = s1

End Function

Private Sub Command1_Click()
Dim A, B, ak()
A = Val(Text1)
B = tuzis(Val(A))
B1 = ksm2(Val(664))
s105 = Split(B, "/")
   j1 = UBound(s105)
    For k = 1 To j1
      n1 = n1 + 1
       ReDim Preserve ak(1 To n1)
      ak(n1) = s105(n1)
    Next
  For I = 18 To j1 - 3
  A = ak(I)
   B = ak(I + 1)
   c = ak(I + 2)
x = MPC1(MPC1(MbC(Trim(A), Trim(B)), Trim(c)), Trim(B1))
  Y = MPC1(MPC1(MbC(Trim(c), Trim(B)), Trim(A)), Trim(B1))
   z = MPC1(MPC1(MbC(Trim(A), Trim(c)), Trim(B)), Trim(B1))
   X1 = MPC1(Trim(x), 2)
  Y1 = MPC1(Trim(Y), 2)
  z1 = MPC1(Trim(z), 2)
   Do While Val(js) <= 10
   js = Val(js + 1)
   If zhengchuqyushu(MCC(Trim(x), 3)) > 1 Or zhengchuqyushu(MCC(Trim(Y), 3)) > 1 Or zhengchuqyushu(MCC(Trim(z), 3)) > 1 Then
  If nStr(fenjieyinzi0(Trim(x)), "*") = 0 And InStr(fenjieyinzi0(Trim(X1)), "*") = 0 Then
  s = s + 1
  s1 = s1 & "/" & s & " /" & x & "/" & X1 & vbCrLf
  ElseIf InStr(fenjieyinzi0(Trim(Y)), "*") = 0 And InStr(fenjieyinzi0(Trim(Y1)), "*") = 0 Then
  s = s + 1
  s1 = s1 & "/" & s & " /" & Y & "/" & Y1 & vbCrLf
  ElseIf InStr(fenjieyinzi0(Trim(z)), "*") = 0 And InStr(fenjieyinzi0(Trim(z1)), "*") = 0 Then
  s = s + 1
  s1 = s1 & "/" & s & " /" & z & "/" & z1 & vbCrLf
  Else
  s = s
  End If
  End If
  x = MPC1(Trim(x), 2)
  Y = MPC1(Trim(Y), 2)
  z = MPC1(Trim(z), 2)
  X1 = MPC1(Trim(x), 2)
  Y1 = MPC1(Trim(Y), 2)
  z1 = MPC1(Trim(z), 2)
Loop
  Next
  
If s > 0 Then
Text2 = s1
Else
Text2 = "wu  jie"
End If
End Sub

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

End Sub

Private Function ksm2(sa As String) As String '2的快速幂程序
Dim A, B
A = Val(2): B = sa
If B = 1 Then
ksm2 = A
ElseIf B = 0 Then
ksm2 = 1
Else
a1 = A
Do While B > 1
s = Int(Log(B) / Log(2))
s1 = 0
Do While s1 < s
A = MbC(Trim(A), Trim(A))
s1 = s1 + 1
Loop
a2 = A
B = B - 2 ^ s
A = a1
If s2 > 0 Then
a3 = MbC(Trim(a3), Trim(a2))
Else
a3 = a2
End If
s2 = s2 + 1
Loop
If B = 1 Then
ksm2 = MbC(Trim(a3), Trim(a1))
Else
ksm2 = a3
End If
s3 = Len(ksm2)
ksm2 = ksm2
End If


End Function

ysr

1152921504617652277是素数，1152921504617652279=3*17*41*71*7765820684339

ysr

Public Function tuzis(sa As String) As String 'tuzi shulie
Dim A, B, c
A = Val(sa)
B = 1
B1 = 0
b2 = 1
b3 = 0
Do While B <= A
B1 = b2

s1 = s1 & "/" & Trim(b3)

b2 = b3
b3 = MPC1(Trim(B1), Trim(b2))


B = Val(B + 1)

Loop
tuzis = s1

End Function

Private Sub Command1_Click()
Dim A, B, ak()
A = Val(Text1)
B = tuzis(Val(A))
B1 = ksm2(Val(664))
s105 = Split(B, "/")
   j1 = UBound(s105)
    For k = 1 To j1
      n1 = n1 + 1
       ReDim Preserve ak(1 To n1)
      ak(n1) = s105(n1)
    Next
  For I = 18 To j1 - 3
  A = ak(I)
   B = ak(I + 1)
   c = ak(I + 2)
x = MPC1(MPC1(MbC(Trim(A), Trim(B)), Trim(c)), Trim(B1))
  Y = MPC1(MPC1(MbC(Trim(c), Trim(B)), Trim(A)), Trim(B1))
   z = MPC1(MPC1(MbC(Trim(A), Trim(c)), Trim(B)), Trim(B1))
   X1 = MPC1(Trim(x), 2)
  Y1 = MPC1(Trim(Y), 2)
  z1 = MPC1(Trim(z), 2)
   Do While Val(js) <= 6
   js = Val(js + 1)
   If zhengchuqyushu(MCC(Trim(x), 3)) > 1 Then
  If InStr(fenjieyinzi0(Trim(x)), "*") = 0 And InStr(fenjieyinzi0(Trim(X1)), "*") = 0 Then s = s + 1: s1 = s1 & "/" & s & " /" & x & "/" & X1 & vbCrLf
  ElseIf zhengchuqyushu(MCC(Trim(Y), 3)) > 1 Then
  If InStr(fenjieyinzi0(Trim(Y)), "*") = 0 And InStr(fenjieyinzi0(Trim(Y1)), "*") = 0 Then s = s + 1: s1 = s1 & "/" & s & " /" & Y & "/" & Y1 & vbCrLf
  ElseIf zhengchuqyushu(MCC(Trim(z), 3)) > 1 Then
  If InStr(fenjieyinzi0(Trim(z)), "*") = 0 And InStr(fenjieyinzi0(Trim(z1)), "*") = 0 Then s = s + 1: s1 = s1 & "/" & s & " /" & z & "/" & z1 & vbCrLf
  Else
  s = s
  End If
  
  x = MPC1(Trim(x), 2)
  Y = MPC1(Trim(Y), 2)
  z = MPC1(Trim(z), 2)
  X1 = MPC1(Trim(x), 2)
  Y1 = MPC1(Trim(Y), 2)
  z1 = MPC1(Trim(z), 2)
Loop
  Next
  
If s > 0 Then
Text2 = s1
Else
Text2 = "wu  jie"
End If
End Sub

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

End Sub

Private Function ksm2(sa As String) As String '2的快速幂程序
Dim A, B
A = Val(2): B = sa
If B = 1 Then
ksm2 = A
ElseIf B = 0 Then
ksm2 = 1
Else
a1 = A
Do While B > 1
s = Int(Log(B) / Log(2))
s1 = 0
Do While s1 < s
A = MbC(Trim(A), Trim(A))
s1 = s1 + 1
Loop
a2 = A
B = B - 2 ^ s
A = a1
If s2 > 0 Then
a3 = MbC(Trim(a3), Trim(a2))
Else
a3 = a2
End If
s2 = s2 + 1
Loop
If B = 1 Then
ksm2 = MbC(Trim(a3), Trim(a1))
Else
ksm2 = a3
End If
s3 = Len(ksm2)
ksm2 = ksm2
End If


End Function

Private Function qqdl(sa As String) As String

  
  For I = 1 To Len(sa)
    If Not Mid(sa, I, 1) = "0" Then
        Exit For
    End If
Next
strTmp = Mid(sa, I)
  If Len(strTmp) = 0 Then
  qqdl = "0"
  Else
qqdl = strTmp
End If
End Function

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

ysr

8的方根为2.82842712474619,方根内有0个，比例（个数/方根）0总数有1个,方根内的:
8=16的方根为4,方根内有1个，比例（个数/方根）0.25总数有2个,方根内的:
16=3+ 13
32的方根为5.65685424949238,方根内有1个，比例（个数/方根）0.176776695296637总数有2个,方根内的:
32=3+ 29
64的方根为8,方根内有2个，比例（个数/方根）0.25总数有5个,方根内的:
64=3+ 61
5+ 59
128的方根为11.3137084989848,方根内有0个，比例（个数/方根）0总数有3个,方根内的:
128=256的方根为16,方根内有1个，比例（个数/方根）0.0625总数有8个,方根内的:
256=5+ 251
512的方根为22.6274169979695,方根内有2个，比例（个数/方根）8.83883476483184E-02总数有11个,方根内的:
512=3+ 509
13+ 499
1024的方根为32,方根内有3个，比例（个数/方根）0.09375总数有22个,方根内的:
1024=3+ 1021
5+ 1019
11+ 1013
2048的方根为45.254833995939,方根内有3个，比例（个数/方根）6.62912607362388E-02总数有25个,方根内的:
2048=19+ 2029
31+ 2017
37+ 2011
4096的方根为64,方根内有5个，比例（个数/方根）0.078125总数有53个,方根内的:
4096=3+ 4093
5+ 4091
17+ 4079
23+ 4073
47+ 4049
8192的方根为90.5096679918781,方根内有2个，比例（个数/方根）2.20970869120796E-02总数有76个,方根内的:
8192=13+ 8179
31+ 8161
16384的方根为128,方根内有3个，比例（个数/方根）0.0234375总数有151个,方根内的:
16384=3+ 16381
23+ 16361
83+ 16301
32768的方根为181.019335983756,方根内有4个，比例（个数/方根）2.20970869120796E-02总数有244个,方根内的:
32768=19+ 32749
61+ 32707
157+ 32611
181+ 32587
65536的方根为256,方根内有5个，比例（个数/方根）0.01953125总数有435个,方根内的:
65536=17+ 65519
89+ 65447
113+ 65423
179+ 65357
227+ 65309

ysr

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, B
a = Val(Text1)

m1 = Val(Text3)
Do While a <= m1
s = 0
Text2 = ""
m = Sqr(a)
a1 = 3
Do While a1 <= m
B = a - a1
c = fenjieyinzi(Val(a1))
d = fenjieyinzi(Val(B))
If InStr(c, "*") = 0 And InStr(d, "*") = 0 Then
s = s + 1
Print a1, "+", B
Text2 = Text2 & CStr(a1) & "+ " & CStr(B) & vbCrLf
Else
s = s
End If
a1 = a1 + 2
Loop
a2 = a1
s1 = s
Do While a2 <= a / 2
B1 = a - a2
C1 = fenjieyinzi(Val(a2))
D1 = fenjieyinzi(Val(B1))

If InStr(C1, "*") = 0 And InStr(D1, "*") = 0 Then
s1 = s1 + 1
Print a2, "+", B1

Else
s1 = s1
End If
a2 = a2 + 2

Loop
s11 = s11 & a & "的方根为" & m & "," & "方根内有" & s & "个，比例（个数/方根）" & s / m & "总数有" & s1 & "个,方根内的:" & vbCrLf & a & "=" & Text2

a = a * 2
Loop
Combo1 = s11

End Sub

Private Sub Command2_Click()
Text1 = ""
Text2 = ""
Text3 = ""
Combo1 = ""
End Sub

ysr

Private Function paixu11(a As String) As String 'paixu cx xiangt bu hebing
Dim i As Integer
Dim ak(), s105
s103 = a

s105 = Split(s103, "/")
   j1 = UBound(s105)
   Print j1
   For k = 1 To j1
      n1 = n1 + 1
       ReDim Preserve ak(1 To n1)
      ak(n1) = s105(n1)
    Next
    Print ak(1)
     
        
     For i = 1 To j1 - 1
        For j = i To j1
            If Val(ak(i)) > Val(ak(j)) Then
                temp = ak(i)
                ak(i) = ak(j)
                ak(j) = temp  'c数组是排序好的
            End If
        Next j
        
        
    Next i
   For i = 1 To j1
     If i Mod 20 = 0 Then
        s104 = s104 & "/" & ak(i) & vbCrLf
        Else
        s104 = s104 & "/" & ak(i)
       End If
     
       Next
      
         Print temp
         MsgBox "ok"
     MsgBox s104  '显示数组
     paixu11 = s104
End Function

ysr

Private Function paixu1(a As String) As String
Dim i As Integer
Dim ak(), s105, cr(), f
s103 = a
Set f = CreateObject("Scripting.Dictionary")
s105 = Split(s103, "/")
   j1 = UBound(s105)
   Print j1
   For k = 1 To j1
      n1 = n1 + 1
       ReDim Preserve ak(1 To n1)
      ak(n1) = s105(n1)
    Next
    Print ak(1)
     
        For k = 1 To j1
           
             ReDim Preserve cr(1 To k)
            m = Val(ak(k))
            f(m) = ""
      Next
   
      n = 0
      m = f.Keys
      For i = 0 To f.Count - 1
          ReDim Preserve cr(1 To i + 1)
          cr(i + 1) = m(i)
      Next
     For i = 1 To UBound(cr) - 1
        For j = i + 1 To UBound(cr)
            If cr(i) > cr(j) Then
                temp = cr(j)
                cr(j) = cr(i)
                cr(i) = temp  'c数组是排序好的
            End If
        Next j
        
       ' If i Mod 20 = 0 Then
       ' s104 = s104 & temp & "/" & vbCrLf
       ' Else
       ' s104 = s104 & temp & "/"
       ' End If
    Next i
   
      For i = 1 To UBound(cr)
        If i Mod 20 = 0 Then
          s104 = s104 & cr(i) & "/" & vbCrLf
        Else
          s104 = s104 & cr(i) & "/"
        End If
     Next
         Print temp
         MsgBox "ok"
     MsgBox s104  '显示数组
     paixu1 = s104
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, b
a = Val(Text1)
q = Val(Text2)
js = Trim(Text3)
js = paixu1(Trim(js))
Text3 = ""

Do While a <= q
s = 0
m = Sqr(a)
a1 = 3
Do While a1 <= m
b = a - a1
c = fenjieyinzi(Val(a1))
d = fenjieyinzi(Val(b))
If InStr(c, "*") = 0 And InStr(d, "*") = 0 Then
s = s + 1

Else
s = s
End If
a1 = a1 + 2
Loop
a2 = a1
s1 = s
Do While a2 <= a / 2
b1 = a - a2
c1 = fenjieyinzi(Val(a2))
d1 = fenjieyinzi(Val(b1))

If InStr(c1, "*") = 0 And InStr(d1, "*") = 0 Then
s1 = s1 + 1

Else
s1 = s1
End If

a2 = a2 + 2

Loop

Text3 = Text3 & "(偶数)(方根内的素数和对个数)(总个数)" & vbCrLf & a & "                " & s & "                " & CStr(s1) & vbCrLf
Print a, s, s1

a = a + 2
Loop

Combo1.Text = js

End Sub

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

End Sub

ysr

Public Function tuzis(sa As String) As String 'tuzi shulie
Dim A, B, c
A = Val(sa)
B = 1
B1 = 0
b2 = 1
b3 = 0
Do While B <= A
B1 = b2

s1 = s1 & "/" & Trim(b3)

b2 = b3
b3 = MPC1(Trim(B1), Trim(b2))


B = Val(B + 1)

Loop
tuzis = s1

End Function

Private Sub Command1_Click()
Dim A, B, ak()
A = Val(Text1)
B = tuzis(Val(A))
Bs = B
B1 = ksm2(Val(664))
s105 = Split(B, "/")
   j1 = UBound(s105)
    For k = 1 To j1
      n1 = n1 + 1
       ReDim Preserve ak(1 To n1)
      ak(n1) = s105(n1)
    Next
  For I = 27 To j1 - 3
  A = ak(I)
   B = ak(I + 1)
   c = ak(I + 2)
x = MPC1(MPC1(MbC(Trim(A), Trim(B)), Trim(c)), Trim(B1))
  Y = MPC1(MPC1(MbC(Trim(c), Trim(B)), Trim(A)), Trim(B1))
   z = MPC1(MPC1(MbC(Trim(A), Trim(c)), Trim(B)), Trim(B1))
   X1 = MPC1(Trim(x), 2)
  Y1 = MPC1(Trim(Y), 2)
  z1 = MPC1(Trim(z), 2)
   Do While Val(js) <= 20
   js = Val(js + 1)
   If zhengchuqyushu(MCC(Trim(x), 3)) > 1 Then
  If InStr(fenjieyinzi0(Trim(x)), "*") = 0 And InStr(fenjieyinzi0(Trim(X1)), "*") = 0 Then s = s + 1: s1 = s1 & "/" & s & " /" & x & "/" & X1 & vbCrLf
  ElseIf zhengchuqyushu(MCC(Trim(Y), 3)) > 1 Then
  If InStr(fenjieyinzi0(Trim(Y)), "*") = 0 And InStr(fenjieyinzi0(Trim(Y1)), "*") = 0 Then s = s + 1: s1 = s1 & "/" & s & " /" & Y & "/" & Y1 & vbCrLf
  ElseIf zhengchuqyushu(MCC(Trim(z), 3)) > 1 Then
  If InStr(fenjieyinzi0(Trim(z)), "*") = 0 And InStr(fenjieyinzi0(Trim(z1)), "*") = 0 Then s = s + 1: s1 = s1 & "/" & s & " /" & z & "/" & z1 & vbCrLf
  Else
  s = s
  End If
  
  x = MPC1(Trim(x), 2)
  Y = MPC1(Trim(Y), 2)
  z = MPC1(Trim(z), 2)
  X1 = MPC1(Trim(x), 2)
  Y1 = MPC1(Trim(Y), 2)
  z1 = MPC1(Trim(z), 2)
Loop
  Next
  
If s > 0 Then
Text2 = s1
Else
Text2 = "wu  jie" & Bs
End If
End Sub

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

End Sub