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

最新推荐文章于 2019-09-14 10:37:07 发布

杨幂等

最新推荐文章于 2019-09-14 10:37:07 发布

阅读量416

点赞数 1

CC 4.0 BY-SA版权

本文链接：https://blog.youkuaiyun.com/Xumuyang_/article/details/78944561

---【机房收费系统】专栏收录该内容

7 篇文章

订阅专栏

本文介绍了一个简单的上机下机管理系统的实现方法，包括用户登录、卡号注册、上机和下机操作等功能。通过VBA代码实现了对学生信息的验证、上机记录的更新以及下机时费用的计算。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

一、前提

当用户登录之后，注册一个卡号，可以进行上下机操作。

二、上机

上机代码：

Private Sub cmdOnline_Click()
    
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrc As ADODB.Recordset
    Dim mrc1 As ADODB.Recordset    'OnLine_Info
    Dim mrc2 As ADODB.Recordset    'Line_Info
    Dim mrc3 As ADODB.Recordset    'Basicdata_Info
    Dim miCount As Integer
    
    txtType.Text = ""
    txtStudentno.Text = ""
    txtName.Text = ""
    txtDepartment.Text = ""
    comboSex.Text = ""
    txtOnlinedate.Text = ""
    txtOnlinetime.Text = ""
    txtOfflinedate.Text = ""
    txtOfflinetime.Text = ""
    txtTime.Text = ""
    txtRemaincash.Text = ""
    txtUsedcash.Text = ""
    
    '卡号是否为空
    If txtCardno = "" Then
        MsgBox "请输入卡号!", vbOKOnly, "提示"
        txtCardno.SetFocus
        txtCardno = ""
        Exit Sub
    End If
    
    '卡号是否注册
    txtSQL = "select * from student_Info where cardno='" & Trim(txtCardno.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF Then
        MsgBox "该卡号尚未注册，请重新输入！", vbOKOnly, "提示"
        txtCardno.SetFocus
        txtCardno = ""
        Exit Sub
    End If
    
    '卡号是否在上机
    txtSQL = "select * from OnLine_Info where cardno='" & Trim(txtCardno.Text) & "'"
    Set mrc1 = ExecuteSQL(txtSQL, MsgText)
    If mrc1.EOF = False Then
        MsgBox "该卡号正在上机！", vbOKOnly, "提示"
        txtCardno = ""
        txtCardno.SetFocus
        txtType.Text = ""
        txtStudentno.Text = ""
        txtName.Text = ""
        txtDepartment.Text = ""
        comboSex.Text = ""
        txtOnlinedate.Text = ""
        txtOnlinetime.Text = ""
        txtOfflinedate.Text = ""
        txtOfflinetime.Text = ""
        txtTime.Text = ""
        txtRemaincash.Text = ""
        txtUsedcash.Text = ""
        Exit Sub
        
    End If
    
    '卡号是否余额不足
    If mrc.Fields(7) <= 5 Then
        If MsgBox("该卡号余额不足，是否充值？", vbOKCancel, "提示") = vbOK Then
            frmrecharge.Show , Me
        End If
        Exit Sub
    End If

    
    '卡号使用状态
    If mrc.Fields(10) = "未使用" Then
        If MsgBox("该卡尚未激活，是否修改学生信息？", vbOKCancel, "提示") = vbOK Then
            frmmodifysinfo.Show , Me
        End If
        Exit Sub
    End If

    '是否设定基础数据
    txtSQL = "select * from basicdata_Info"
    Set mrc3 = ExecuteSQL(txtSQL, MsgText)
    If mrc3.EOF Then
        If MsgBox("该卡尚未设定基础数据，无法登录，是否设定？", vbOKCancel, "提示") = vbOK Then
            frmsetbasicdata.Show , Me
        End If
        Exit Sub
    End If
    
    '上机成功，更新上机界面信息
    txtSQL = "select * from student_Info where cardno='" & Trim(txtCardno.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    '显示数据
    txtStudentno.Text = Trim(mrc.Fields(1))
    txtDepartment.Text = Trim(mrc.Fields(4))
    txtType.Text = Trim(mrc.Fields(14))
    txtName.Text = Trim(mrc.Fields(2))
    comboSex.Text = Trim(mrc.Fields(3))
    txtOnlinedate.Text = Trim(Date)
    txtOnlinetime.Text = Trim(Time)
    txtRemaincash.Text = Val(Trim(mrc.Fields(7)))
    
    '更新上机表信息
    txtSQL = "select * from OnLine_Info"
    Set mrc1 = ExecuteSQL(txtSQL, MsgText)
    
    mrc1.AddNew
    mrc1.Fields(0) = Trim(txtCardno.Text)
    mrc1.Fields(1) = Trim(txtType.Text)
    mrc1.Fields(2) = Trim(txtStudentno.Text)
    mrc1.Fields(3) = Trim(txtName.Text)
    mrc1.Fields(4) = Trim(txtDepartment.Text)
    mrc1.Fields(5) = Trim(comboSex.Text)
    mrc1.Fields(6) = Trim(txtOnlinedate.Text)
    mrc1.Fields(7) = Trim(txtOnlinetime.Text)
    mrc1.Fields(8) = Trim("ZOEY")
    mrc1.Fields(9) = Trim(Date)
    mrc1.Update
    lblOnlineNum.Caption = mrc1.RecordCount
    '显示当前上机人数
    mrc1.Close
    
    '增加上机记录
    txtSQL = "select * from Line_Info"
    Set mrc2 = ExecuteSQL(txtSQL, MsgText)
    mrc2.AddNew
    mrc2.Fields(1) = Trim(txtCardno.Text)
    mrc2.Fields(2) = Trim(txtStudentno.Text)
    mrc2.Fields(3) = Trim(txtName.Text)
    mrc2.Fields(4) = Trim(txtDepartment.Text)
    mrc2.Fields(5) = Trim(comboSex.Text)
    mrc2.Fields(6) = Trim(txtOnlinedate.Text)
    mrc2.Fields(7) = Trim(txtOnlinetime.Text)
    mrc2.Fields(13) = Trim("正常上机")
    mrc2.Fields(14) = Trim("ZOEY")
    mrc2.Update
    mrc2.Close
    
    '更新上机人数
    txtSQL = "select count(*) from OnLine_Info "
    Set mrc1 = ExecuteSQL(txtSQL, MsgText)
    
    Label15.Caption = mrc1.RecordCount + 1
    
End Sub

三、下机

下机代码：

Private Sub cmdOffline_Click()
    
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrc As ADODB.Recordset   'student_info
    Dim mrc1 As ADODB.Recordset  'bascidata_info
    Dim mrc2 As ADODB.Recordset  'line_info
    Dim mrc3 As ADODB.Recordset  'online_info
    
    '卡号是否为空
    If txtCardno = "" Then
        MsgBox "请输入卡号!", vbOKOnly, "提示"
        txtCardno.SetFocus
        txtCardno = ""
        Exit Sub
    End If
    
    '卡号是否存在
    txtSQL = "select * from student_Info where cardno='" & Trim(txtCardno.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF Then
        MsgBox "不存在该卡号！", vbOKOnly, "提示"
        txtCardno.SetFocus
        txtCardno = ""
        Exit Sub
    End If
    
    '卡号是否正在上机
    txtSQL = "select * from OnLine_Info where cardno='" & Trim(txtCardno.Text) & "'"
    Set mrc3 = ExecuteSQL(txtSQL, MsgText)
    If mrc3.EOF Then
        MsgBox "该用户未上机！", vbOKOnly, "提示"
        txtCardno.SetFocus
        txtCardno = ""
        txtType.Text = ""
        txtStudentno.Text = ""
        txtName.Text = ""
        txtDepartment.Text = ""
        comboSex.Text = ""
        txtOnlinedate.Text = ""
        txtOnlinetime.Text = ""
        txtOfflinedate.Text = ""
        txtOfflinetime.Text = ""
        txtTime.Text = ""
        txtRemaincash.Text = ""
        txtUsedcash.Text = ""
        Exit Sub
    End If
    
    '更新界面信息
    txtType.Text = Trim(mrc3.Fields(1))
    txtStudentno.Text = Trim(mrc3.Fields(2))
    txtName.Text = Trim(mrc3.Fields(3))
    txtDepartment.Text = Trim(mrc3.Fields(4))
    comboSex.Text = Trim(mrc3.Fields(5))
    txtOnlinedate.Text = Trim(mrc3.Fields(6))
    txtOnlinetime.Text = Trim(mrc3.Fields(7))
    txtOfflinedate.Text = Trim(Date)
    txtOfflinetime.Text = Trim(Time)
    txtTime.Text = Trim(DateDiff("n", Trim(txtOnlinetime.Text), Trim(Time))) '把时间差转换为分钟
    
        
    '从基本数据表获取数据
    txtSQL = "select * from BasicData_Info "
    Set mrc1 = ExecuteSQL(txtSQL, MsgText)
    
    '计算消费金额
    Dim MinTime As Integer
    Dim AllTime As Single
    Dim Rate As Single
    Dim Money As Integer
    
    MinTime = mrc1.Fields(3)
    AllTime = txtTime.Text
    
    '上机时间小于准备时间，不算时间,不花钱
    If Trim(txtTime.Text) < MinTime Then
        txtTime.Text = 0 & ""
        Money = 0
    Else
        If AllTime > MinTime Then
            Do While AllTime > MinTime
                AllTime = AllTime - 30
                If mrc.Fields(14) = "固定用户" Then
                    Money = Money + 2
                Else
                    Money = Money + 3
                End If
            Loop
         End If
     End If
     txtUsedcash.Text = Money
        
    '计算余额
    txtSQL = "select * from student_Info where cardno='" & Trim(txtCardno.Text) & "'and status='" & "使用" & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    
    txtRemaincash.Text = Val(Trim(mrc.Fields(7))) - Val(Trim(txtUsedcash.Text))
    
    txtSQL = "Update student_Info set cash='" & Trim(txtUsedcash.Text) & "' where cardno='" & Trim(txtCardno.Text) & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    
    MsgBox "下机成功！", vbOKOnly, "提示"
    
    '更新Line表
    txtSQL = "select * from Line_Info "
    Set mrc2 = ExecuteSQL(txtSQL, MsgText)
    
    If Not mrc2.EOF Then
        mrc2.AddNew
        mrc2.Fields(1) = Trim(txtCardno.Text)
        mrc2.Fields(2) = Trim(txtStudentno.Text)
        mrc2.Fields(3) = Trim(txtName.Text)
        mrc2.Fields(4) = Trim(txtDepartment.Text)
        mrc2.Fields(5) = Trim(comboSex.Text)
        mrc2.Fields(6) = Trim(txtOnlinedate.Text)
        mrc2.Fields(7) = Trim(txtOnlinetime.Text)
        mrc2.Fields(8) = Trim(txtOfflinedate.Text)
        mrc2.Fields(9) = Trim(txtOfflinetime.Text)
        mrc2.Fields(10) = Trim(txtTime.Text)
        mrc2.Fields(11) = Trim(txtUsedcash.Text)
        mrc2.Fields(12) = Trim(txtRemaincash.Text)
        mrc2.Fields(13) = "正常下机"
        mrc2.Fields(14) = Trim(Environ("computername"))
        mrc2.Update
        mrc2.Close
    End If
    
    mrc3.Delete
        
    '更新上机人数
    txtSQL = "select count(*) from OnLine_Info "
    Set mrc3 = ExecuteSQL(txtSQL, MsgText)
    Label15.Caption = mrc3.RecordCount
    
End Sub

清空大脑，理清思路，考虑周全，按照自己想要的结果去执行就好了。