【机房收费系统】——上下机

谁借莪１个温暖的怀抱￠ 2022-08-04 12:59 177阅读 0赞

用户登录系统后消费，上下机是首要的操作，这一部分我花了很长时间才完成，中间遇到的问题不计其数，但最终还是解决了，心里的石头总算落下了。先来看图说说思路吧。

一、知识网

![Center][]

![Center 1][]

二、代码解释

（一）上机：

Private Sub cmdonLine_Click()
        
        '从student中查询cardno
        txtSQL = "select * from student_info where cardno= '" & txtCardno.Text & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        '判断卡号是否为空
        If txtCardno.Text = "" Then
            MsgBox "请输入卡号！", vbOKOnly + vbExclamation, "警告"
            txtCardno.SetFocus
            txtCardno.Text = ""
            Exit Sub
        End If
        '检查卡号是否存在
        If mrc.EOF And mrc.BOF Then
            MsgBox "卡号不存在！", vbOKOnly + vbExclamation, "警告"
            txtCardno.SetFocus '获得焦点
            txtCardno.Text = "" '定义数据集对象
            Exit Sub
        End If
        
        '查询基本数据设定表
        txtSQL = "select * from basicdata_info "
        Set mrcdata = ExecuteSQL(txtSQL, MsgText)
        
        '判断该卡号余额是否充足
        If mrc.Fields(7) < mrcdata.Fields(5) Then
            MsgBox "余额只有" & mrc.Fields(7) & ",少于最少金额，请先充值！", vbOKOnly, "警告!"
            txtCardno.Text = "" '清空
            txtCardno.SetFocus '获得焦点
            Exit Sub
        End If
        
        '判断该卡号是否在上机
        txtSQL = "select * from online_info where cardno= '" & txtCardno.Text & "'"
        Set onmrc = ExecuteSQL(txtSQL, MsgText)
        '数据库中是否为空
        If (onmrc.EOF Or onmrc.BOF) = False Then '若不为空
            MsgBox "该卡号正在上机！", vbOKOnly + vbExclamation, "警告" '提示正在上机
            '如果在上机则从onmrc中调取上机记录显示在text中
            txtType = Trim(onmrc.Fields(1))
            txtStudentno = Trim(onmrc.Fields(2))
            txtStudentname = Trim(onmrc.Fields(3))
            txtDepartment = Trim(onmrc.Fields(4))
            txtSex = Trim(onmrc.Fields(5))
            txtOndate = Trim(Format(onmrc.Fields(6), "yyyy-mm-dd"))
            txtOntime = Trim(Format(onmrc.Fields(7), "hh:mm:ss"))
            txtCash = Trim(mrc.Fields(7))
        Else
            '如果没上机，查询student中记录
            txtSQL = "select * from online_info where cardno='" & txtCardno & "'"
            Set onmrc = ExecuteSQL(txtSQL, MsgText)
            '将信息显示在text框中
            txtType = Trim(mrc.Fields(14))
            txtStudentno = Trim(mrc.Fields(1))
            txtStudentname = Trim(mrc.Fields(2))
            txtDepartment = Trim(mrc.Fields(4))
            txtSex = Trim(mrc.Fields(3))
            txtOndate = Trim(Format(Date, "yyyy-mm-dd"))
            txtOntime = Trim(Format(Time, "hh:mm:ss"))
            txtCash = Trim(mrc.Fields(7))
            
            '更新上机online数据库
            onmrc.AddNew
            onmrc.Fields(0) = Trim(txtCardno)
            onmrc.Fields(1) = Trim(txtType)
            onmrc.Fields(2) = Trim(txtStudentno)
            onmrc.Fields(3) = Trim(txtStudentname)
            onmrc.Fields(4) = Trim(txtDepartment)
            onmrc.Fields(5) = Trim(txtSex)
            onmrc.Fields(6) = Trim(Format(txtOndate, "yyyy-mm-dd"))
            onmrc.Fields(7) = Trim(Format(txtOntime, "hh:mm:ss"))
            onmrc.Fields(8) = Trim(VBA.Environ("computername")) '机器名
            onmrc.Fields(9) = Trim(Now) '当前时间
            onmrc.Update '更新数据集对象
            onmrc.close '关闭数据集对象
            '提示上机成功
            MsgBox "上机成功！", vbOKOnly + vbExclamation, "警告"
    '        txtcardno.Text = "" '清空卡号
            
            txtCardno.SetFocus '获得焦点
        End If
        
        '上机清空文本框
            txtOfftime = ""
            txtOffdate = ""
            txtConsumetime = ""
            txtConsume = ""
        
    End Sub

（二）下机：

Private Sub cmdLine_Click()
        '定义变量
        Dim Leasttime, Pretime As Integer
        Dim intLinetime As Integer
        Dim Consumetime As Integer
        Dim curConsume As Currency
        Dim curCash As Currency
        Dim strType As String
        
        '从student中查卡号
        txtSQL = "select * from student_info where cardno= '" & txtCardno.Text & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        
        '获取online表中的数据
        txtSQL = "select * from online_info"
        Set onmrc = ExecuteSQL(txtSQL, MsgText)
    
        
        '卡号是否为空
        If txtCardno.Text = "" Then
            MsgBox "请输入卡号！", vbOKOnly + vbExclamation, "警告"
            txtCardno.SetFocus
            txtCardno.Text = ""
            Exit Sub
        End If
        
        '该卡号是否已注册
        If mrc.EOF Then
            MsgBox "该卡号未注册！", vbOKOnly + vbExclamation, "警告"
            txtCardno.SetFocus
            txtCardno.Text = ""
            Exit Sub
        End If
        
        '查上机卡号
        txtSQL = "select * from online_info where cardno='" & Trim(txtCardno.Text) & "'"
        Set onmrc = ExecuteSQL(txtSQL, MsgText)
        
        '如果未上机，则提示未上机
        If onmrc.EOF Then
            MsgBox "该卡号未上机！", vbOKOnly + vbExclamation, "警告"
            txtCardno.Text = "" '清空
            txtCardno.SetFocus '获得焦点
            Exit Sub
        End If
            
        '查basicdata表
        txtSQL = "select * from basicdata_info"
        Set mrcdata = ExecuteSQL(txtSQL, MsgText)
        '得出准备时间和至少上机时间
        Pretime = Val(Trim(mrcdata.Fields(4)))
        Leasttime = Val(Trim(mrcdata.Fields(3)))
        
        
        '计算消费时间
        txtSQL = "select * from online_info where cardno='" & Trim(txtCardno.Text) & "'"
        Set onmrc = ExecuteSQL(txtSQL, MsgText)
        intLinetime = (Date - DateValue(onmrc!Ondate)) * 1440 + (Hour(Time) - Hour(TimeValue(onmrc!ontime))) * 60 + (Minute(Time) - Minute(TimeValue(onmrc!ontime)))
    '        intlinetime = Val(DateDiff("n", offtime, ontime))
        
        '如果实际上机时间小于准备时间，则不收钱
        If intLinetime <= Pretime Then
            Consumetime = "0.0"
        Else '否则消费时间 = 实际上机时间 - 准备时间
            Consumetime = intLinetime - Pretime
            If Consumetime < Leasttime Then '如果消费时间小于至少上机时间
               Consumetime = Leasttime  '则按最少时间算
            Else  '若消费时间大于至少上机时间
                Consumetime = Round(Consumetime / mrcdata.Fields(2)) * mrcdata.Fields(2) 'round函数四舍五入
            End If
        End If
        
        '不同用户每小时的收费
        If strType = "固定用户" Then
            curConsume = Consumetime / 60 * mrcdata.Fields(0) '固定用户每小时消费金额
        Else
            curConsume = Consumetime / 60 * mrcdata.Fields(1) '临时用户每小时消费金额
        End If
        
        '判断消费金额是否小于最低收费
        If curConsume > 0 And curConsume < mrcdata.Fields(5) Then
            curConsume = mrcdata.Fields(5)
        End If
        
        '计算余额//{账户余额=原-消费}
        curCash = mrc!Cash - curConsume
        
        '下机信息显示
        txtSQL = "select * from online_info"
        Set onmrc = ExecuteSQL(txtSQL, MsgText)
        '显示下机信息
        txtOfftime = Format(Time, "hh:mm:ss")
        txtOffdate = Format(Date, "yyyy-mm-dd")
        txtType = Trim(onmrc.Fields(1))
        txtStudentno = Trim(onmrc.Fields(2))
        txtStudentname = Trim(onmrc.Fields(3))
        txtDepartment = Trim(onmrc.Fields(4))
        txtSex = Trim(onmrc.Fields(5))
        txtOndate = Format(onmrc.Fields(6), "yyyy-mm-dd")
        txtOntime = Format(onmrc.Fields(7), "hh:mm:ss")
        txtConsumetime.Text = Consumetime
        txtConsume.Text = curConsume
        txtCash.Text = curCash
        
        '更新学生信息表余额
        mrc!Cash = txtCash
        mrc.Update
        mrc.close
        
        '更新下机表记录
        txtSQL = "select * from line_info "
        Set lmrc = ExecuteSQL(txtSQL, MsgText)
        lmrc.AddNew
        lmrc.Fields(1) = Trim(txtCardno)
        lmrc.Fields(2) = Trim(txtStudentno)
        lmrc.Fields(3) = Trim(txtStudentname)
        lmrc.Fields(4) = Trim(txtDepartment)
        lmrc.Fields(5) = Trim(txtSex)
        lmrc.Fields(6) = Trim(Format(txtOndate, "yyyy-mm-dd"))
        lmrc.Fields(7) = Trim(Format(txtOntime, "hh:mm:ss"))
        lmrc.Fields(8) = Trim(Format(Date, "yyyy-mm-dd"))
        lmrc.Fields(9) = Trim(Format(Time, "hh:mm:ss"))
        lmrc.Fields(10) = Trim(txtConsumetime)
        lmrc.Fields(11) = Val(Trim(txtConsume))
        lmrc.Fields(12) = Val(Trim(txtCash))
        lmrc.Fields(13) = "正常下机"
        lmrc.Fields(14) = Trim(VBA.Environ("computername"))
        lmrc.Update   '更新下机数据集对象
        lmrc.close  '关闭数据集对象
        '提示下机成功
        MsgBox "您已成功下机！", vbOKOnly + vbExclamation, "警告"
        Call ExecuteSQL(txtSQL, MsgText)
        
        '删除相应的在线卡状态表记录
        onmrc.Delete
        LabelNum.Caption = LabelNum.Caption - 1  '更新上机人数
        
        '下机清空文本框中的记录
        txtCardno.Text = ""
        txtOfftime.Text = ""
        txtOffdate.Text = ""
        txtStudentno.Text = ""
        txtStudentname.Text = ""
        txtDepartment.Text = ""
        txtSex.Text = ""
        txtType.Text = ""
        txtOndate.Text = ""
        txtOntime.Text = ""
        txtConsumetime.Text = ""
        txtConsume.Text = ""
        txtCash.Text = ""
        txtCardno.SetFocus  '卡号框获得焦点，方便用户
        
    End Sub

三、总结

通过这次做上下机，清楚了基本流程，锻炼了自信心，增加了代码熟练度，考虑更周全了，总之受益很大，机房收费系统的完成，告诉我，一接触就知道敲代码是不可取的，而思路才是最重要的，只要先梳理好思路，敲起代码来很容易就可以完成。

[Center]: /images/20220731/4ee093f7ac7a46b391ac3de43cf7f141.png
[Center 1]: /images/20220731/b8a071d87c83408f97cfa1298d578df2.png