数学.frm

实现M5加密算法的源程序

VERSION 5.00
Begin VB.Form Maths 
   Caption         =   "数学"
   ClientHeight    =   3210
   ClientLeft      =   3585
   ClientTop       =   3315
   ClientWidth     =   4695
   Icon            =   "数学.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3210
   ScaleWidth      =   4695
   WhatsThisHelp   =   -1  'True
   Begin VB.TextBox tval 
      Height          =   3255
      Left            =   0
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   0
      Width           =   4695
   End
   Begin VB.Menu mnuFile 
      Caption         =   "文件(&F)"
      Begin VB.Menu mnuSelectAll 
         Caption         =   "全选(&A)"
         Shortcut        =   ^A
      End
      Begin VB.Menu mnuCopy 
         Caption         =   "复制(&C)"
      End
      Begin VB.Menu mnuSpe 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退出(&E)"
      End
   End
   Begin VB.Menu mnuTheroy 
      Caption         =   "数论(&T)"
      Begin VB.Menu mnuPrime 
         Caption         =   "素数"
         Begin VB.Menu mnuSushu 
            Caption         =   "素数个数"
         End
         Begin VB.Menu mnuSushuSpe 
            Caption         =   "区间素数个数"
         End
         Begin VB.Menu mnuPrimePoly 
            Caption         =   "素数表达式"
         End
         Begin VB.Menu mnuConject 
            Caption         =   "偶Goldbach猜想"
         End
         Begin VB.Menu mnuMersern 
            Caption         =   "Mersern素数"
         End
         Begin VB.Menu mnuFen 
            Caption         =   "分解质因数"
         End
      End
      Begin VB.Menu mnuChai 
         Caption         =   "拆分函数表"
      End
      Begin VB.Menu mnuGe 
         Caption         =   "格点问题"
         Begin VB.Menu mnuChu 
            Caption         =   "除数问题"
         End
         Begin VB.Menu mnuNe 
            Caption         =   "圆内格点问题"
         End
      End
      Begin VB.Menu mnuSqr 
         Caption         =   "平方和问题"
      End
      Begin VB.Menu mnuThreePlus 
         Caption         =   "3N+1问题"
      End
      Begin VB.Menu mnuGolomb 
         Caption         =   "Golomb尺"
      End
      Begin VB.Menu mnuQueen 
         Caption         =   "八皇后问题"
      End
      Begin VB.Menu mnuYouLi 
         Caption         =   "骑士游历问题"
      End
      Begin VB.Menu mnuBu 
         Caption         =   "不定方程"
         Begin VB.Menu mnuPell 
            Caption         =   "Pell方程"
         End
      End
      Begin VB.Menu mnuSort 
         Caption         =   "排序"
         Begin VB.Menu mnuDis 
            Caption         =   "显示"
            Index           =   0
         End
         Begin VB.Menu mnuDis 
            Caption         =   "不显示"
            Index           =   1
         End
      End
      Begin VB.Menu mnuCal 
         Caption         =   "精确计算"
         Begin VB.Menu mnuChen 
            Caption         =   "阶乘"
         End
         Begin VB.Menu mnuTwo 
            Caption         =   "2的方幂"
         End
         Begin VB.Menu mnuPI 
            Caption         =   "PI"
         End
         Begin VB.Menu mnuPIQuick 
            Caption         =   "PI(C)"
         End
      End
   End
   Begin VB.Menu mnuSum 
      Caption         =   "计算数学(&N)"
      Begin VB.Menu mnuEqu 
         Caption         =   "方程求根"
         Begin VB.Menu mnuGen 
            Caption         =   "两分法"
            Index           =   0
         End
         Begin VB.Menu mnuGen 
            Caption         =   "Newton法"
            Index           =   1
         End
         Begin VB.Menu mnuGen 
            Caption         =   "切比雪夫迭代法"
            Index           =   2
         End
         Begin VB.Menu mnuGen 
            Caption         =   "斯梯芬森方法"
            Index           =   3
         End
      End
      Begin VB.Menu mnuMatrix 
         Caption         =   "解线性方程组"
         Begin VB.Menu mnuXiao 
            Caption         =   "Gauss消元法"
            Index           =   0
         End
         Begin VB.Menu mnuXiao 
            Caption         =   "Seidel迭代法"
            Index           =   1
         End
         Begin VB.Menu mnuXiao 
            Caption         =   "共轭斜量法"
            Index           =   2
         End
      End
      Begin VB.Menu mnuGetNi 
         Caption         =   "求逆矩阵"
         Begin VB.Menu mnuNi 
            Caption         =   "无回代消去法"
            Index           =   0
         End
         Begin VB.Menu mnuNi 
            Caption         =   "解方程组法"
            Index           =   1
         End
      End
      Begin VB.Menu mnuValue 
         Caption         =   "矩阵特征值"
         Begin VB.Menu mnuEigen 
            Caption         =   "Jaccobi法"
            Index           =   0
         End
         Begin VB.Menu mnuEigen 
            Caption         =   "吉文斯-HouseHolder法"
            Index           =   1
         End
         Begin VB.Menu mnuEigen 
            Caption         =   "QR方法"
            Index           =   2
         End
      End
      Begin VB.Menu mnuMin 
         Caption         =   "函数最小值"
         Begin VB.Menu mnuCha 
            Caption         =   "0.618法"
            Index           =   0
         End
         Begin VB.Menu mnuCha 
            Caption         =   "分数法"
            Index           =   1
         End
         Begin VB.Menu mnuCha 
            Caption         =   "三次插值法"
            Index           =   2
         End
         Begin VB.Menu mnuCha 
            Caption         =   "抛物线法"
            Index           =   3
         End
      End
      Begin VB.Menu mnuDifferentiation 
         Caption         =   "数值微分"
         Begin VB.Menu mnuDiff 
            Caption         =   "Larrange公式"
            Index           =   0
            Begin VB.Menu mnuLarrange 
               Caption         =   "一阶导数"
               Index           =   0
            End
            Begin VB.Menu mnuLarrange 
               Caption         =   "二阶导数"
               Index           =   1
            End
         End
         Begin VB.Menu mnuDiff 
            Caption         =   "外推法"
            Index           =   1
         End
         Begin VB.Menu mnuDiff 
            Caption         =   "Simpson公式"
            Index           =   2
         End
      End
      Begin VB.Menu mnuIntegration 
         Caption         =   "定积分"
         Begin VB.Menu mnuCotes 
            Caption         =   "Cotes公式"
            Index           =   0
         End
         Begin VB.Menu mnuCotes 
            Caption         =   "切比雪夫公式"
            Index           =   1
         End
         Begin VB.Menu mnuGauss 
            Caption         =   "Romberg法"
            Index           =   0
         End
         Begin VB.Menu mnuGauss 
            Caption         =   "加速法"
            Index           =   1
         End
         Begin VB.Menu mnuGauss 
            Caption         =   "Gauss型求积公式"
            Index           =   2
         End
         Begin VB.Menu mnuEXP 
            Caption         =   "带权exp(-x)的样条积分"
         End
      End
      Begin VB.Menu mnuWei 
         Caption         =   "常微分方程初值问题"
         Begin VB.Menu mnuWeiChu 
            Caption         =   "Euler折线法"
            Index           =   0
         End
         Begin VB.Menu mnuWeiChu 
            Caption         =   "改进的Euler折线法"
            Index           =   1
         End
         Begin VB.Menu mnuWeiChu 
            Caption         =   "Runge-Kutta法(4阶)"
            Index           =   2
         End
         Begin VB.Menu mnuWeiChu 
            Caption         =   "Adams法"
            Index           =   3
         End
         Begin VB.Menu mnuWeiChu 
            Caption         =   "Milne法"
            Index           =   4
         End
         Begin VB.Menu mnuWeiChu 
            Caption         =   "哈明方法"
            Index           =   5
         End
         Begin VB.Menu mnuWeiChu 
            Caption         =   "Obrechkoff公式"
            Index           =   6
         End
      End
      Begin VB.Menu mnuFFT 
         Caption         =   "FFT"
      End
      Begin VB.Menu mnuBaoTu 
         Caption         =   "保凸拟合"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mnuAbout 
         Caption         =   "关于(&A)"
      End
   End
End
Attribute VB_Name = "Maths"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub mnuAbout_Click()
ShellAbout Me.hwnd, "数学", "欢迎使用!", Me.Icon
End Sub

Private Sub mnuFile_Click()
mnuCopy.Enabled = tval.SelLength
mnuSelectAll.Enabled = Len(tval)
End Sub

Private Sub mnuSelectAll_Click()
With tval
    .SelStart = 0
    .SelLength = Len(.Text)
End With
End Sub

Private Sub mnuCopy_Click()
Clipboard.SetText tval.SelText
End Sub

Private Sub mnuExit_Click()
Unload Me
End Sub

Private Sub mnuSushu_Click()
Dim i As Long, m As Long, d As Long, n As Long, k As Long, g As Long, j As Long
Dim a() As Byte
On Error GoTo err
n = ask("请输入范围N", "素数个数", lng)
If n < 0 Then Exit Sub
Start = GetTime
m = 2: k = 1
ReDim a(n)
Call Field(a(), n)
For i = 5 To n Step 6
    If a(i) = 0 Then m = m + 1
Next i
For i = 7 To n Step 6
    If a(i) = 0 Then
        m = m + 1
        If a(i - 2) = 0 Then k = k + 1
    End If
Next i
tval = "1至" & n & "中共有" & m & "个素数" & vbCrLf & "1至" & n & "中共有" & k & "对孪生素数"
MsgBox "共耗时" & Str((GetTime - Start) / freq) & "秒", vbInformation
err:
End Sub

Private Sub mnuSushuSpe_Click()
Dim a() As Byte, low As Long, high As Long, i As Long, st1 As Long, st2 As Long, k As Long
low = ask("请输入起始值", "区间内素数个数", lng)
If low < 0 Then Exit Sub
high = ask("请输入终止值", "区间内素数个数", lng)
If high < 0 Then Exit Sub
If low > high Then MsgBox "起始值应小于终止值", vbCritical: Exit Sub
If low < 4 Then MsgBox "起始值太小", vbCritical: Exit Sub
Start = GetTime
ReDim a(low To high)
FieldA a(), low, high
i = low Mod 6
If i > 1 Then
    st1 = low + 7 - i
Else
    st1 = low + 1 - i
End If
st2 = low + 5 - i
For i = st1 To high Step 6
    If a(i) = 0 Then k = k + 1
Next i
For i = st2 To high Step 6
    If a(i) = 0 Then k = k + 1
Next i
tval = low & "到" & high & "之间共" & k & "个素数"
MsgBox "共耗时" & Str((GetTime - Start) / freq) & "秒", vbInformation
End Sub

Private Sub mnuPrimePoly_Click()
Dim a() As Byte, n As Long, i As Long
n = ask("请输入范围N", "素数表达式", lng)
ReDim a(n + 200)
If n < 0 Then Exit Sub
Field a(), n + 200
For i = 41 To n Step 30
    If PrimePoly(a(), i) = 0 Then tval = tval & i & vbCrLf
    If PrimePoly(a(), i + 6) = 0 Then tval = tval & i + 6 & vbCrLf
Next i
End Sub

Private Sub mnuMersern_Click()
Dim n As Long
n = ask("请输入N", "Mersern素数", lng)
If n < 3 Then Exit Sub
If Prime(n) = False Then MsgBox "请输入素数", vbCritical: Exit Sub
Start = GetTime
If Mersern(n) Then tval = "M" & n & "是素数" Else tval = "M" & n & "不是素数"
MsgBox "共耗时" & Str((GetTime - Start) / freq) & "秒", vbInformation
End Sub

Private Sub mnuConject_Click()
Dim n As Long
n = ask("请输入范围N(N>=6)", "偶Goldbach猜想", lng)
If n < 0 Then Exit Sub
If n < 6 Then MsgBox "请输入大于等于6的数", vbExclamation, "偶Goldbach猜想": Exit Sub
Start = GetTime
tval = "共" & Goldbach(n) & "种"
MsgBox "共耗时" & Str((GetTime - Start) / freq) & "秒", vbInformation
End Sub

Private Sub mnuFen_Click()
Dim n As Long
tval = ""
n = ask("请输入要分解的数", "分解质因数", lng)
Do Until n = -1
    tval = tval & Fen(n) & vbCrLf
    n = ask("请输入要分解的数", "分解质因数", lng)
Loop
End Sub

Function Fen(ByVal n As Long) As String
Dim i As Long
Dim al As Boolean
al = True
If n = 1 Then
    Fen = "1不能被分解"
    Exit Function
End If
Fen = Fen & n
If n > 3 Then Fen = Fen & Devide(n, 2, al)
If n > 8 Then Fen = Fen & Devide(n, 3, al)
For i = 5 To Sqr(n + 0.5) Step 6
    Fen = Fen & Devide(n, i, al)
    Fen = Fen & Devide(n, i + 2, al)
Next i
If al Then
    Fen = Fen & "是素数"
Else
    If n <> 1 Then Fen = Fen & "*" & n
End If
End Function
Function Devide(n As Long, i As Long, al As Boolean) As String
Do
If (n Mod i) = 0 Then
    n = n / i
    If al Then
        Devide = Devide & "=" & i: al = False
    Else
        Devide = Devide & "*" & i
    End If
Else
    Exit Function
End If
Loop Until n = 1
End Function

Private Sub mnuChai_Click()
Dim p(126)
Dim t As Long
Dim i As Integer, j As Integer
Dim m As Integer, k As Integer
Dim o As String
p(0) = 1: p(1) = 1: tval = ""
For i = 2 To 126
    k = 2
    Do
    m = i - w(k)
    If m >= 0 Then
        If (k Mod 2) = 1 Then
            t = t + p(m)
        Else
            t = t - p(m)
        End If
    End If
    k = k + 1
    Loop Until m < 0
    k = -1
    Do
    m = i - w(k)
    If m >= 0 Then
        If ((k + 10) Mod 2) = 1 Then
            t = t + p(m)
        Else
            t = t - p(m)
        End If
    End If
    k = k - 1
    Loop Until m < 0
    p(i) = t + p(i - 1)
    t = 0
Next i
o = Space(7)
For i = 1 To 25