机房收费系统之上下机

一、前言

完成了机房收费系统后，觉得之前的逻辑图只有大构架，一些细节还是不够清晰，于是回过头来，重新整理了一下上下机逻辑图，顺便晒下代码。

二、内容

1、上机逻辑图

2、上机代码

Private Sub cmdUp_Click()
    txtDate.Text = ""
    txtTime.Text = ""
    txtdistime.Text = ""
    txtdiscash.Text = ""

'是否为空
    If Not TxTe(txtCardNo.Text) Then
        MsgBox "请您输入上机卡号！",vbOKOnly + 48,"提示"
        txtCardNo.SetFocus
        txtCardNo.Text = ""
        Exit Sub
    End If
'是否在线
    txtsql = "select*from online_info where cardno='" & txtCardNo.Text & "'"
    Set mrc = Executesql(txtsql,MsgText)
    If mrc.EOF = False Then
        MsgBox "该卡已经上机！","提示"
        txtCardNo.SetFocus
        txtCardNo.Text = ""
        Exit Sub
        mrc.Close
    End If
'判断有无该卡号
    txtsql = "select*from student_info where cardno='" & txtCardNo.Text & "'"
    Set mrc = Executesql(txtsql,MsgText)
    If mrc.EOF Then
        MsgBox "无该卡号，请重新输入！","提示"
        txtCardNo.SetFocus
        txtCardNo.Text = ""
        Exit Sub
    End If
'是否使用状态
    If mrc.Fields(8) = "未使用" Then
        If MsgBox("该卡未激活！是否修改学生信息？",vbOKCancel,"提示") = vbOK Then
            frminformation.Show,Me
        End If
        Exit Sub
    End If
'是否有余额
    If mrc.Fields(1) <= 0 Then
        If MsgBox("该卡号余额不足，是否前往充值？","提示") = vbOK Then
            frmRecharge.Show,Me
        End If
        Exit Sub
    End If
    mrc.Close
'是否设定基础数据
    txtsql = "select*from basicdata_info"
    Set mrc = Executesql(txtsql,MsgText)
    If mrc.EOF Then
        If MsgBox("未设定基础数据，无法登陆，是否前往设定？","提示") = vbOK Then
            frmSetting.Show,Me
        End If
        Exit Sub
    End If
    mrc.Close
'更新上机界面信息
    '提取学生表
    txtsql = "select*from student_info where cardno='" & txtCardNo.Text & "'"
    Set mrc = Executesql(txtsql,MsgText)
    
    txtStudentNo.Text = Trim(mrc.Fields(4))
    txtType.Text = Trim(mrc.Fields(9))
    txtCash.Text = Trim(mrc.Fields(1))
    txtStudentName.Text = Trim(mrc.Fields(2))
    txtDepartment.Text = Trim(mrc.Fields(5))
    txtSex.Text = Trim(mrc.Fields(3))
    txtOnDate.Text = Trim(Date)
    txtOnTime.Text = Trim(Time)
    
'更新上机表信息
    Dim bas As ADODB.Recordset
    Dim bsql As String,bMsg As String
    '提取上机表和基础数据表
    txtsql = "select*from online_info"
    Set mrc = Executesql(txtsql,MsgText)
    bsql = "select*from basicdata_info"
    Set bas = Executesql(bsql,bMsg)

    mrc.AddNew
    mrc.Fields(0) = Trim(txtCardNo.Text)
    mrc.Fields(1) = Trim(txtType.Text)
    mrc.Fields(2) = Trim(txtStudentNo.Text)
    mrc.Fields(3) = Trim(txtStudentName.Text)
    mrc.Fields(4) = Trim(txtSex.Text)
    mrc.Fields(5) = Trim(txtDepartment.Text)
    mrc.Fields(6) = Trim(txtOnDate.Text)
    mrc.Fields(7) = Trim(txtOnTime.Text)
    mrc.Fields(8) = Trim(PCName)
    mrc.Fields(9) = Now

    mrc.Fields(10) = Trim(txtCash.Text)
    mrc.Fields(11) = 1
    '用户消费方式
    If txtType.Text = "固定会员" Then
        mrc.Fields(12) = Val(Trim(bas.Fields(0)))
    Else
        If txtType.Text = "临时用户" Then
            mrc.Fields(12) = Val(Trim(bas.Fields(1)))
        Else
            MsgBox "该卡号未设定用户类型，登陆失败！",vbOKOnly,"提示"
            Exit Sub
        End If
    End If
    mrc.Update
    txtCardNo.SetFocus
    txtCardNo.Text = ""

'更新上机人数
    txtsql = "select*from online_info"
    Set mrc = Executesql(txtsql,MsgText)
    LoginNumber.Caption = "当前上机人数为：" & mrc.RecordCount
    mrc.Close
End Sub

3、扣费

有关扣费请观阅： 机房收费系统之上机扣费

4、下机逻辑图

5、下机代码

Private Sub cmdDown_Click()
'是否为空
    If Not TxTe(txtCardNo.Text) Then
        MsgBox "请您输入下机卡号！",MsgText)
    If mrc.EOF Then
        MsgBox "用户未上机。","提示"
        txtCardNo.SetFocus
        txtCardNo.Text = ""
        Exit Sub
    End If
    
'更新界面信息
    txtStudentNo.Text = Trim(mrc.Fields(2))
    txtType.Text = Trim(mrc.Fields(1))
    txtStudentName.Text = Trim(mrc.Fields(3))
    txtDepartment.Text = Trim(mrc.Fields(5))
    txtSex.Text = Trim(mrc.Fields(4))
    txtOnDate.Text = Trim(mrc.Fields(6))
    txtOnTime.Text = Trim(mrc.Fields(7))
    txtcash.Text = Trim(mrc.Fields(10))
    txtdistime.Text = Trim(mrc.Fields(11))
    txtDate.Text = Date
    txtTime.Text = Time
    '更新Online表数据
    mrc.Delete
    mrc.Close
    '计算消费金额
    txtsql = "select*from student_info where cardno='" & txtCardNo.Text & "'"
    Set mrc = Executesql(txtsql,MsgText)
    txtdiscash.Text = Val(Trim(mrc.Fields(1))) - Val(Trim(txtcash.Text))
    mrc.Close
'更新下机信息
    Dim STD As ADODB.Recordset
    Dim tsql As String,mText As String
    '提取学生表和下线表
    tsql = "select*from student_info where cardno='" & txtCardNo.Text & "'"
    Set STD = Executesql(tsql,mText)
    txtsql = "select*from line_info order by serial desc"
    Set mrc = Executesql(txtsql,MsgText)
    
    '写入数据
    mrc.AddNew
    mrc.Fields(1) = Trim(txtCardNo.Text)
    mrc.Fields(2) = Trim(txtStudentNo.Text)
    mrc.Fields(3) = Trim(txtStudentName.Text)
    mrc.Fields(4) = Trim(txtDepartment.Text)
    mrc.Fields(5) = Trim(txtSex.Text)
    mrc.Fields(6) = Trim(txtOnDate.Text)
    mrc.Fields(7) = Trim(txtOnTime.Text)
    mrc.Fields(8) = Trim(txtDate.Text)
    mrc.Fields(9) = Trim(txtTime.Text)
    mrc.Fields(10) = Trim(txtdistime.Text)
    mrc.Fields(11) = Trim(txtdiscash.Text)
    mrc.Fields(12) = Trim(txtcash.Text)
    mrc.Fields(14) = Trim(PCName)
    STD.Fields(1) = Trim(txtcash.Text)
    '学生卡状态
    If Trim(STD.Fields(8)) = "使用" Then
        mrc.Fields(13) = Trim("使用")
    Else
        mrc.Fields(13) = Trim("未使用")
    End If
    mrc.Update
    STD.Update
    STD.Close
    mrc.Close
'更新上机人数
    txtsql = "select*from online_info"
    Set mrc = Executesql(txtsql,MsgText)
    LoginNumber.Caption = "当前上机人数为：" & mrc.RecordCount
    mrc.Close
End Sub

三、总结

做项目前，做好产品逻辑构造，可以起到事半功倍的作用，大构架掌控的是方向，而模块逻辑把控的是产品质量，每一次锻炼，都让我在待人待物上得到很大的提升。