frmland.frm

软件工程实验报告 银行储蓄管理系统 1.可行性分析 2.总体设计 3.详细设计 4.实验报告模板

Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rst As Recordset
'''''''''''''''''''''''''''
Dim svPw As String
Dim haveDB As Boolean

' 根据 "此用户密码为空" 复选框，判断其它控件的状态 chkNPw(checkkNullPassword)
Private Sub chkNPw_Click()
    If chkNPw.Value = 1 Then        '如果 "此用户密码为空" 复选框已被选中
        txtSUPw.PasswordChar = ""       '数据库登陆密码输入框密码符为空
        txtSUPw.Text = "NULL"           '数据库登陆密码输入框显示 NULL
        txtSUPw.Enabled = False         '数据库登陆密码输入框不可使用
        chkWL.Enabled = False           '"使用 Windows 身份验证" 复选框不可使用
    Else                            '如果 "此用户密码为空" 复选框未被选中
        txtSUPw.PasswordChar = "*"      '数据库登陆密码输入框密码符为 *
        txtSUPw.Text = ""               '数据库登陆密码输入框显示为空
        txtSUPw.Enabled = True          '数据库登陆密码输入框可以使用
        txtSUPw.SetFocus                '数据库登陆密码输入框获得焦点
        chkWL.Enabled = True            '"使用 Windows 身份验证" 复选框可使用
    End If
End Sub

' 根据 "使用 Windows 身份验证" 复选框，判断其它控件的状态 chkWL(checkkWindowsLand)
Private Sub chkWL_Click()
    If chkWL.Value = 1 Then         '如果"使用 Windows 身份验证" 复选框已被选中
        txtSUName.Text = "NULL"         '数据库登陆名输入框为显示 NULL
        txtSUPw.PasswordChar = ""       '数据库登陆密码密码符为空
        txtSUPw.Text = "NULL"           '数据库登陆密码输入框显示 NULL
        txtSUName.Enabled = False       '数据库登陆名输入框不可使用
        txtSUPw.Enabled = False         '数据库登陆密码输入框不可使用
        chkNPw.Enabled = False          '"此用户密码为空"复选框不可使用
    Else                            '如果"使用 Windows 身份验证" 复选框未被选中
        txtSUName.Text = ""             '数据库登陆名输入框为空
        txtSUName.Enabled = True        '数据库登陆名输入框可使用
        txtSUPw.PasswordChar = "*"      '数据库登陆密码密码符为 *
        txtSUPw.Text = ""               '数据库登陆密码输入框为空
        txtSUPw.Enabled = True          '数据库登陆密码输入框可使用
        chkNPw.Enabled = True           '"此用户密码为空" 复选框可以使用
    End If
End Sub

' 响应 "确定" 按钮
Private Sub cmdOK_Click()
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' 给全局变量赋值↓
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    userName = txtUName.Text        '系统登陆名
    userPw = txtUPw.Text            '系统登陆密码
    SName = cmbSName.Text           '数据库服务器名
    SUName = txtSUName.Text         '数据库登陆名
    '''''''''''''''''''''''''''''''''''''''''''''''''''''
    If chkWL.Value = 1 Then         '根据用户的登陆方式不同而赋给变量 landWay 不同的值
        landWay = 0                 '如果用户的登陆方式为 Windows 身份验证
    Else
        landWay = 1                 '如果用户的登陆方式为帐户登陆
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If chkNPw.Value = 0 And chkWL.Value = 0 Then    '数据库登陆密码
        SUPw = txtSUPw.Text                         '如果密码不为空
    Else
        SUPw = ""                                   '如果密码为空
    End If
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' 判断用户的输入是否正确↓
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If userName = "" Then           '如果系统登陆名为空
        MsgBox "用户名不能为空", vbExclamation, "登陆错误"
        txtUName.SetFocus
        Exit Sub
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If userPw = "" Then             '如果系统登陆密码为空
        MsgBox "用户密码不能为空", vbExclamation, "登陆错误"
        txtUPw.SetFocus
        Exit Sub
    End If
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If SName = "" Then              '如果数据库名为空
        MsgBox "请选择一个服务器", vbExclamation, "登陆错误"
        cmbSName.SetFocus
        Exit Sub
    End If
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If SUName = "" Then             '如果数据库登陆名为空
        MsgBox "数据库服务器用户名不能为空", vbExclamation, "登陆错误"
        txtSUName.SetFocus
        Exit Sub
    End If
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If SUPw = "" And chkNPw.Value = 0 And chkWL.Value = 0 Then      '如果数据库登陆密码为空，且非 Windows 身份验证
        MsgBox "数据库服务器用户密码不能为空", vbExclamation, "登陆错误"
        txtSUPw.SetFocus
        Exit Sub
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim errVSv As Boolean
    errVSv = True
    Call LinkDB(landWay, SName, "master", SUName, SUPw)
    On Error GoTo errSv
    con.Open
    con.Close
    errVSv = False
errSv:
    If errVSv Then                  '判断数据库服务器能否使用
        MsgBox "请确定服务器，及登陆服务器的用户名、密码正确，并且服务器已开启", vbExclamation, "登陆错误"
        Exit Sub
    End If
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '维护系统数据库↓
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Not getDB Then   '如果没有找到数据库
        If MsgBox("数据库未找到，单击 OK 按钮创建", vbOKCancel, "提示") = vbOK Then
            Call createDB           '创建数据库
            Call createATable       '创建利率表
            Call createUTable       '创建工作人员表
            Call createCCTable      '创建活期存款表
            Call createFCTable      '创建定期存款表
            MsgBox "数据库已创建完成"
            Unload Me
            frmWelcome.Show
        End If
        Exit Sub
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Not getTheTable("accrual") Then  '如果利率表未找到
        If MsgBox("利率表未找到，单击 OK 按钮创建", vbOKCancel, "系统错误") = vbOK Then
            Call createATable           '创建利率表
            MsgBox "表已创建完成"
            Unload Me
            frmWelcome.Show
        End If
        Exit Sub
    End If
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Not getTheTable("users") Then    '如果工作人员表未找到
        If MsgBox("管理员表未找到，单击 OK 按钮创建", vbOKCancel, "系统错误") = vbOK Then
            Call createUTable           '创建工作人员表
            MsgBox "表已创建完成"
            Unload Me
            frmWelcome.Show
        End If
        Exit Sub
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Not getTheTable("CConsumers") Then   '如果活期存款表未找到
        If MsgBox("用户表未找到，单击 OK 按钮创建", vbOKCancel, "系统错误") = vbOK Then
            Call createCCTable              '创建活期存款表
            MsgBox "表已创建完成"
            Unload Me
            frmWelcome.Show
        End If
        Exit Sub
    End If
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Not getTheTable("FConsumers") Then   '如果定期存款表未找到
        If MsgBox("定期存款表未找到，单击 OK 按钮创建", vbOKCancel, "系统错误") = vbOK Then
            Call createFCTable              '创建定期存款表
            MsgBox "表已创建完成"
            Unload Me
            frmWelcome.Show
        End If
        Exit Sub
    End If
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' 判断用户的登陆↓
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If userLand Then        '如果用户登陆成功
        Call getPercentage  '获取利率信息
        Call saveReg        '保存信息到注册表
        Unload Me
        MDIFrmMain.Show
    Else
        MsgBox "请确定，用户名及密码正确", vbExclamation, "登陆错误"
        
    End If
End Sub

' 响应 "取消" 按钮
Private Sub cmdCc_Click()
    Unload Me
End Sub

' 响应 "..." 按钮
Private Sub cmdSM_Click()
    If MsgBox("加载服务器可能需要数分钟的时间，请点击 OK 开始加载！", vbOKCancel, "提示") = vbOK Then
        frmGetSv.Show 1     '如果确定进行服务器加载，调用服务器加载面板
    End If
End Sub

' 创建 weboy 数据库
Private Sub createDB()
    Call LinkDB(landWay, SName, "master", SUName, SUPw)     '此语句用于连接数据库，具体可以到 shareFunction 模块中找到说明
    con.Open
    con.Execute "create database weboy"
    con.Close
End Sub

' 在 weboy 数据库里创建利率表 accrual
Private Sub createATable()
    Call LinkDB(landWay, SName, "weboy", SUName, SUPw)      '此语句用于连接数据库，具体可以到 shareFunction 模块中找到说明
    con.Open
    con.Execute "create table accrual(theYear char(1),percentage float)"
    con.Close
End Sub

' 在 weboy 数据库里创建工作人员表 users,并插入初始数据
Private Sub createUTable()
    Call LinkDB(landWay, SName, "weboy", SUName, SUPw)      '此语句用于连接数据库，具体可以到 shareFunction 模块中找到说明
    con.Open
    con.Execute "create table users(name varchar(12),password varchar(12),power varchar(12))"
    con.Execute "insert users values('admin','weboy','admin')"  '赋始用户登陆信息
    con.Close
End Sub

' 在 weboy 数据库里创建活期存款表 CConsumers
Private Sub createCCTable()
    Call LinkDB(landWay, SName, "weboy", SUName, SUPw)      '此语句用于连接数据库，具体可以到 shareFunction 模块中找到说明
    con.Open
    con.Execute "create table CConsumers(ID char(15),password varchar(12),userName varchar(12),deputizeName varchar(12),userStationID varchar(25),deputizeStationID varchar(25),userAddress varchar(50),userPhone varchar(20),deputizePhone varchar(20),memoryWay char(4),procedurePerson varchar(12))"
    con.Close
End Sub

' 在 weboy 数据库里创建定期存款表 FConsumers
Private Sub createFCTable()
    Call LinkDB(landWay, SName, "weboy", SUName, SUPw)      '此语句用于连接数据库，具体可以到 shareFunction 模块中找到说明
    con.Open
    con.Execute "create table FConsumers(ID char(15),name varchar(12),password varchar(12),money float,passTime float,stationID varchar(25),address varchar(50),Phone varchar(20),CAccrual float,FAccrual float,procedurePerson varchar(12),be char(1),fetchDate varchar(25))"
    con.Close
End Sub

'判断用户的登陆是否合法
Private Function userLand() As Boolean
    Call LinkDB(landWay, SName, "weboy", SUName, SUPw)      '此语句用于连接数据库，具体可以到 shareFunction 模块中找到说明
    con.Open
    Set rst = New Recordset
    userLand = False    '将本函数的初值赋为 False
    rst.Open "select * from users", con, adOpenDynamic, adLockOptimistic
    rst.MoveFirst
    Do While Not rst.EOF
        If rst!name = txtUName Then         '如果能找到此用户
            If rst!password = userPw Then   '并且此用户的密码正确
                userPower = rst!power       '将用户的权限赋给全局变量 userPower
                userLand = True             '本函数据为 True 登陆成功
                Exit Function
            End If
        End If
        rst.MoveNext
    Loop
    
    rst.Close
    con.Close
    
End Function

'判断是否把服器名保存到注册表
Private Sub saveReg()
    If chkSS.Value = 1 Then     '如果 "记住服务器" 复选框被选中
        SaveSetting "weboy", "weboyBank", "IfSaveSvName", "1"   '保存信息为 1
        SaveSetting "weboy", "weboyBank", "SName", SName        '保存服务器名
    Else    '如果未被选中
        SaveSetting "weboy", "weboyBank", "IfSaveSvName", "0"   '保存信息为 0
    End If
End Sub

'从数据库中调出利率
Private Sub getPercentage()
    Call LinkDB(landWay, SName, "weboy", SUName, SUPw)      '此语句用于连接数据库，具体可以到 shareFunction 模块中找到说明
    con.Open
    Set rst = New Recordset
    
    Dim errAV As Boolean
    errAV = True
    On Error GoTo errA
    rst.Open "select * from accrual", con, adOpenDynamic, adLockOptimistic
    rst.MoveFirst
    errAV = False
errA:
    If Not errAV Then   '如果利率表未出现问题
        percentage0 = rst!percentage    '给活期利率 percentage0 赋值
        rst.MoveNext
        percentage1 = rst!percentage    '一年
        rst.MoveNext
        percentage2 = rst!percentage    '二年
        rst.MoveNext
        percentage3 = rst!percentage    '三至五年
        rst.MoveNext
        percentage5 = rst!percentage    '五至八年
        rst.MoveNext
        percentage8 = rst!percentage    '八年以上
        rst.Close
    Else                '如果利率表出现问题
        MsgBox "利率出现问题请速去修改"
        percentage0 = 0
        percentage1 = 0
        percentage2 = 0
        percentage3 = 0
        percentage5 = 0
        percentage8 = 0
        rst.Close
    End If
End Sub