机房收费系统之上下机

一、前言

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

二、内容

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 "该卡已经上机！", vbOKOnly + 48, "提示"        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 "无该卡号，请重新输入！", vbOKOnly + 48, "提示"        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("该卡号余额不足，是否前往充值？", vbOKCancel, "提示") = 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("未设定基础数据，无法登陆，是否前往设定？", vbOKCancel, "提示") = 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.CloseEnd Sub

3、扣费

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

4、下机逻辑图

5、下机代码

Private Sub cmdDown_Click()'是否为空    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 Then        MsgBox "用户未上机。", vbOKOnly + 48, "提示"        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.CloseEnd Sub

三、总结

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