【VB与数据库】机房收费系统设计阶段之上下机

       背景： 不知道大家有没有留意过这个现象，在现在很多的电子商务中的交费掏钱的时候，系统跳转的非常慢，只要所有跟钱联系上的都很慢，在机房中也有涉及到钱的地方，而且比较费脑子，他不但要考虑各个方面的问题，还要把最后的钱算对，所以总结一下这里是不可避免的。在机房中的除了有刚登进界面的上下机，在学生查看上机状态查看中还有和钱有关的窗体。

 

 

现在梳理一下MDI窗体上的上下机步骤：

上机流程图：

上机代码：

上机代码没有难度，就要锻炼自己的一个逻辑思维，还要把握全局观。

Private Sub cmdoncom_Click()                             '设置上机键
Dim mrc As ADODB.Recordset
Dim mrcc As ADODB.Recordset
Dim mrcd As ADODB.Recordset
Dim mrce As ADODB.Recordset
Dim mrcb As ADODB.Recordset
Dim txtSQL As String
Dim MsgText As String
    Timer2.Enabled = True
    '判断是否正在上机
    txtSQL = "select * from OnLine_Info where cardno ='" & Trim(txtcardno.Text) & "'"        '判断是否正在上机
    Set mrcd = ExecuteSQL(txtSQL, MsgText)
    If Not mrcd.EOF Then
        MsgBox "此卡正在上机！", 0 + 48, "提示"
        Exit Sub
    End If
    mrcd.Close
    '判断是否输入卡号
    If txtcardno.Text = "" Then                                                            '判断卡号是否为空
        MsgBox "请输入卡号！", 0 + 48, "提示"
        Exit Sub
    End If
    '判断卡号是否是数字
    If Not IsNumeric(Trim(txtcardno.Text)) Then                                             '卡号得为数字
        MsgBox "请输入数字！", vbOKOnly + vbExclamation, "警告"
        Exit Sub
    End If
    '判断卡号是否是活跃卡
    txtSQL = "select * from student_Info where cardno ='" & Trim(txtcardno.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF Then
        MsgBox "卡号不存在或者已经不用了", 0 + 48, "提示"                                   '判断卡号是否被使用
        Exit Sub
        mrc.Close
    End If
    '判断卡的余额是否够
    If mrc.Fields(7) <= 0 Then
            MsgBox "亲，余额不足，请充值！", 0 + 48, "提示"                                  '判断余额是否还有
            Exit Sub
            mrc.Close
        Else
            txtstudentNo.Text = mrc.Fields(1)
            txtDepartment.Text = mrc.Fields(4)
            txttype.Text = mrc.Fields(14)
            txtName.Text = mrc.Fields(2)
            txtSex.Text = mrc.Fields(3)
            txtondate.Text = Format(Date, "yyyy-mm-dd")
            txtontime.Text = Format(Time, "hh:mm")
            txtcash.Text = mrc.Fields(7)
            txtoffdate.Text = ""
            txtofftime.Text = ""
            txtcosttime.Text = ""
            txtcost.Text = ""
            mrc.Close
    End If
    '更新上机记录表中的数据
    txtSQL = "select * from Line_Info"
    Set mrcc = ExecuteSQL(txtSQL, MsgText)
    mrcc.AddNew
    mrcc.Fields(1) = Trim(txtcardno.Text)
    mrcc.Fields(2) = Trim(txtstudentNo.Text)
    mrcc.Fields(3) = Trim(txtName.Text)
    mrcc.Fields(4) = Trim(txtDepartment.Text)
    mrcc.Fields(5) = Trim(txtSex.Text)
    mrcc.Fields(6) = txtondate.Text
    mrcc.Fields(7) = txtontime.Text
    mrcc.Fields(8) = Null
    mrcc.Fields(9) = Null
    mrcc.Fields(10) = Null
    mrcc.Fields(11) = Trim("0.0")
    mrcc.Fields(12) = Trim(txtcash.Text)
    mrcc.Fields(13) = Trim("正常上机")
    mrcc.Fields(14) = Trim(VBA.Environ("computername"))      '获取计算机名
    mrcc.Update
    '更新正在线的用户
    txtSQL = "select * from OnLine_Info"
    Set mrce = ExecuteSQL(txtSQL, MsgText)
    mrce.AddNew
    mrce.Fields(0) = Trim(txtcardno.Text)
    mrce.Fields(1) = Trim(txttype.Text)
    mrce.Fields(2) = Trim(txtstudentNo.Text)
    mrce.Fields(3) = Trim(txtName.Text)
    mrce.Fields(4) = Trim(txtDepartment.Text)
    mrce.Fields(5) = Trim(txtSex.Text)
    mrce.Fields(6) = Trim(txtondate.Text)
    mrce.Fields(7) = Trim(txtontime.Text)
    mrce.Fields(8) = Trim(VBA.Environ("computername"))     '获取计算机名
    mrce.Fields(9) = Date
    mrce.Update
    mrce.Close
    mrcc.Close
    MsgBox "恭喜您，上机成功！", 0 + 48, "提示"
    onliner = onliner + 1
    Label22.Caption = onliner
End Sub

下机流程图：

下机代码：

在下机代码中，有一些地方是比较费脑子的：

①计算上机时间，用到了DateDiff函数

②计算上机费用，分三种情况进行计算，

  第一种情况:上机时间<准备时间                  

           花费为0；

  第二种情况:准备时间<上机时间<最下上机时间     

           花费为1；

  第二种情况:上机时间>最小上机时间

           计算用时(S)=上机时间(T)-准备时间(A)

           计算用时周期（UnitNumber）=计算用时（S）MOD 递增用时周期

           判断用户类别确定每小时上机费用（D）

           计算花销=计算用时周期（UnitNumber）* 每小时上机费用（D）           

 
Private Sub cmdoffcom_Click()
Dim mrc As ADODB.Recordset
Dim mrcc As ADODB.Recordset
Dim mrcd As ADODB.Recordset
Dim mrce As ADODB.Recordset
Dim txtSQL As String
Dim MsgText As String
Dim Usetime, UnitNumber, a
    '判断下机卡号是否为空
    If txtcardno.Text = "" Then                          '判断卡号是否为空
        MsgBox "请输入卡号！", 0 + 48, "提示"
        Exit Sub
        txtcardno.SetFocus
        txtcardno.Text = ""
    End If
    '判断下机卡号是否是数字
    If Not IsNumeric(txtcardno.Text) Then                 '判断卡号是否为数字
        MsgBox "卡号请输入数字！", 0 + 48, "提示"
        txtcardno.SetFocus
        txtcardno.Text = ""
        Exit Sub
    End If
    '判断卡号是否还在使用
    txtSQL = "select * from student_Info where cardno ='" & Trim(txtcardno.Text) & "'"
    Set mrcd = ExecuteSQL(txtSQL, MsgText)
    If mrcd.EOF Then
        MsgBox "卡号不存在或者已经不用了", 0 + 48, "提示"                                   '判断卡号是否被使用
        Exit Sub
    End If
    '判断输入的卡号是否在上机
    txtSQL = "select * from OnLine_Info where cardno = '" & Trim(txtcardno.Text) & "'"
    Set mrce = ExecuteSQL(txtSQL, MsgText)
    If mrce.EOF Then
        MsgBox "亲，此卡号没有上机，请重新选择！", vbOKOnly + vbExclamation, "警告"
        txtstudentNo.Text = ""
        txtDepartment.Text = ""
        txttype.Text = ""
        txtName.Text = ""
        txtSex.Text = ""
        txtondate.Text = ""
        txtontime.Text = ""
        txtcash.Text = ""
        txtoffdate.Text = ""
        txtofftime.Text = ""
        txtcosttime.Text = ""
        txtcost.Text = ""
        txtcardno.Text = ""
        Exit Sub
    Else
        txtstudentNo.Text = mrcd.Fields(1)
        txtDepartment.Text = mrcd.Fields(4)
        txttype.Text = mrcd.Fields(14)
        txtName.Text = mrcd.Fields(2)
        txtSex.Text = mrcd.Fields(3)
        txtondate.Text = mrce.Fields(6)
        txtontime.Text = mrce.Fields(7)
        c = mrce.Fields(7)
        txtontime.Text = c
        mrce.Delete
    End If
    '下机并更新上机记录中的数据
    txtSQL = "select * from Line_Info where status ='正常上机' and cardno ='" & Trim(txtcardno.Text) & "'"
    Set mrcc = ExecuteSQL(txtSQL, MsgText)
        txtoffdate.Text = Format(Date, "yyyy-mm-dd")
        txtofftime.Text = Format(Time, "hh:mm")
        b = Abs(DateDiff("n", txtofftime, c))                         '计算上机时间
        txtcosttime.Text = b
        mrcc.Fields(8) = Trim(txtoffdate.Text)
        mrcc.Fields(9) = Trim(txtofftime.Text)
        mrcc.Fields(10) = Trim(txtcosttime.Text)
        mrcc.Fields(13) = Trim("正常下机")
    '计算上机时间
    txtSQL = "select * from BasicData_Info "
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    '第一种情况:上机时间<准备时间
    If Val(txtcosttime.Text) < Val(mrc.Fields(4)) Then                '上机时间小于准备时间
        txtcost.Text = 0
        onliner = onliner - 1
        Label22.Caption = onliner
        mrcc.Fields(11) = Trim(txtcost.Text)
        mrcc.Fields(12) = Trim(txtcash.Text)
        mrcc.Update
        Exit Sub
    '第二种情况:准备时间<上机时间<最下上机时间
    ElseIf Val(mrc.Fields(4)) <= Val(txtcosttime.Text) And Val(txtcosttime.Text) <= Val(mrc.Fields(3)) Then    '准备时间<上机时间<最少上机时间
        txtcost.Text = 1
        txtcash.Text = Val(mrcd.Fields(7)) - 1
        mrcd.Fields(7) = Trim(txtcash.Text)
        mrcd.Update
        mrcc.Fields(11) = Trim(txtcost.Text)
        mrcc.Fields(12) = Trim(txtcash.Text)
        mrcc.Update
        onliner = onliner - 1
        Label22.Caption = onliner
        Exit Sub
    '第二种情况:上机时间>最小上机时间
    ElseIf Val(txtcosttime.Text) > Val(mrc.Fields(3)) Then           '上机时间>最小上机时间
        Usetime = Val(txtcosttime.Text) - Val(mrc.Fields(4))
        UnitNumber = Usetime Mod Val(mrc.Fields(2))
            If UnitNumber = 0 Then                                   '用时小于周期
                UnitNumber = Int(Usetime / Val(mrc.Fields(2)))       'int是取整函数，取证原则是比括号中的数值小的最接近的整数，不进行四舍五入。 所以 比-2.9还小的整数是-3，同样分析知道，int(2.9)=2
            Else                                                     '用时大于周期  如  90/60=1.5  int(1.5)=1   说以要+1
                UnitNumber = Int(Usetime / Val(mrc.Fields(2))) + 1
            End If
    End If
    '判断此时用户类别
    If mrcd.Fields(14) = "固定用户  " Then
        a = Val(mrc.Fields(0))
    Else
        a = Val(mrc.Fields(1))
    End If
    '计算最后的花销
    txtcost.Text = Format(UnitNumber * a, "0.0")                      '计算最后的花费
    txtcash.Text = Val(mrcd.Fields(7)) - Val(txtcost.Text)
    mrcd.Fields(7) = Trim(txtcash.Text)
    mrcd.Update
    mrcc.Fields(11) = Trim(txtcost.Text)
    mrcc.Fields(12) = Trim(txtcash.Text)
    mrcc.Update
    onliner = onliner - 1
    Label22.Caption = onliner
End Sub
 小结：经历了算账的过程，不仅是代码的锻炼，更是思维的锻炼。上下机是很值得反复推敲的，我的也有 很多的问题，还需要完善，也希望我的总结可以给你带来帮助。