机房收费系统（二）-上下机

最新推荐文章于 2024-08-22 00:17:13 发布

有名呀

最新推荐文章于 2024-08-22 00:17:13 发布

阅读量256

点赞数

分类专栏： # 机房收费管理系统文章标签： VB

本文链接：https://blog.youkuaiyun.com/frj0260/article/details/83861400

版权

机房收费管理系统专栏收录该内容

7 篇文章

订阅专栏

本文详细解析了一套机房管理系统的上下机操作代码，包括上机和下机的流程控制、余额检查、在线时长计算及数据库同步更新等功能。通过具体代码示例，展示了如何实现卡号验证、上机状态判断、消费金额计算等关键步骤。

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

【前言】
开始做机房时间也不短了，也看了不少大佬的博客，但是真的是每个人有每个人的思路，所以我也有了自己的思路。刚开始的时候没有什么思路，不知道如何下手，只有静下心来，一点点往下走，才能理清自己的思路。有些地方可能还存在不足，望指点。
【内容】
上机和下机导图
在这里插入图片描述

上机代码

Private Sub cmdOnLine_Click()

Dim MsgText As String
Dim Stusql As String
Dim OnLinesql As String
Dim Linesql As String
Dim BasicDatasql As String
Dim mrcStu As ADODB.Recordset
Dim mrcOnLine As ADODB.Recordset
Dim mrcLine As ADODB.Recordset
Dim mrcBasicData As ADODB.Recordset
   
    '判断卡号是否为空
    If txtCardNo.Text = "" Then
        MsgBox "卡号不能为空，请输入卡号！", 48, "警告"
        txtCardNo.SetFocus
        Exit Sub
    End If
     
    '判断卡号是否为数字
    If Not IsNumeric(Trim(txtCardNo.Text)) Then
        MsgBox "请输入数字！", vbOKOnly + vbExclamation, "警告"
        txtCardNo.Text = ""
        txtCardNo.SetFocus
        Exit Sub
    End If
    
    '判断该卡号是否已注册
    Stusql = "select * from student_Info where cardno= '" & Trim(txtCardNo.Text) & "'"
    Set mrcStu = ExecuteSQL(Stusql, MsgText)
    If mrcStu.EOF = True Then
        MsgBox "该卡号不存在，请注册！", 48, "警告"
        txtCardNo.Text = ""
        txtCardNo.SetFocus
        Exit Sub
    Else
        '判断卡号是否退卡
        If mrcStu.EOF Then
            MsgBox "此卡已经退卡", vbOKOnly + vbExclamation, "提示"
            txtCardNo.Text = ""
            txtCardNo.SetFocus
            Exit Sub
        End If
    End If
        
    '判断余额是否充足
    BasicDatasql = "select * from BasicData_Info"
    Set mrcBasicData = ExecuteSQL(BasicDatasql, MsgText)
    If mrcStu.Fields(7) < mrcBasicData.Fields(5) Then
        MsgBox "余额不足，请先充值再上机！", 48, "提示"
        Exit Sub
    End If
    
    '判断该卡号是否正在上机
    OnLinesql = "select * from OnLine_Info where cardno='" & Trim(txtCardNo.Text) & "'"
    Set mrcOnLine = ExecuteSQL(OnLinesql, MsgText)
    If mrcOnLine.EOF = False Then
        MsgBox "该卡正在上机，不能重复上机！", 64, "提示"
        Exit Sub
    End If
    
    '调用学生信息到输入框
    txtCardNo.Text = mrcStu.Fields(0)
    txtType.Text = mrcStu.Fields(14)
    txtSID.Text = mrcStu.Fields(1)
    txtName.Text = mrcStu.Fields(2)
    txtDept.Text = mrcStu.Fields(4)
    comboSex.Text = mrcStu.Fields(3)
    txtCash.Text = mrcStu.Fields(7)
    txtOnDate.Text = Date
    txtOnTime.Text = Time
    txtOffDate.Text = ""
    txtOffTime.Text = ""
    txtCMoney.Text = ""
    txtCTime = ""
      
    '上机时将上机卡的数据同步至online_info表中
    Set mrcOnLine = New ADODB.Recordset
    OnLinesql = "select * from OnLine_info"
    Set mrcOnLine = ExecuteSQL(OnLinesql, MsgText)
    mrcOnLine.AddNew
    mrcOnLine.Fields(0) = Trim(txtCardNo.Text)
    mrcOnLine.Fields(1) = Trim(txtType.Text)
    mrcOnLine.Fields(2) = Trim(txtSID.Text)
    mrcOnLine.Fields(3) = Trim(txtName.Text)
    mrcOnLine.Fields(4) = Trim(txtDept.Text)
    mrcOnLine.Fields(5) = Trim(comboSex.Text)
    mrcOnLine.Fields(6) = Trim(txtOnDate.Text)
    mrcOnLine.Fields(7) = Trim(txtOnTime.Text)
    mrcOnLine.Fields(8) = Trim(VBA.Environ("computername"))    '将计算机名同步到数据库的相应表格中
    lblAmount.Caption = mrcOnLine.RecordCount + 1  '显示上机人数
    mrcOnLine.Update
    mrcOnLine.Close
    
    '上机时将上机卡的数据同步到line_info表中
    Set mrcLine = New ADODB.Recordset
    Linesql = "select * from line_info"
    Set mrcLine = ExecuteSQL(Linesql, MsgText)
    mrcLine.AddNew
    mrcLine.Fields(1) = Trim(txtCardNo.Text)
    mrcLine.Fields(2) = Trim(txtSID.Text)
    mrcLine.Fields(3) = Trim(txtName.Text)
    mrcLine.Fields(4) = Trim(txtDept.Text)
    mrcLine.Fields(5) = Trim(comboSex.Text)
    mrcLine.Fields(6) = Trim(txtOnDate.Text)
    mrcLine.Fields(7) = Trim(txtOnTime.Text)
    mrcLine.Fields(13) = "正常上机"
    mrcLine.Fields(14) = Trim(VBA.Environ("computername"))
    mrcLine.Update
    mrcLine.Close
    MsgBox "上机成功！", 64, "提示"
        
    '显示正在上机的人数
    OnLinesql = "select * from OnLine_Info"
    Set mrcOnLine = ExecuteSQL(OnLinesql, MsgText)
    If mrcOnLine.EOF = True Then
        lblAmount.Caption = 0
    Else
        lblAmount.Caption = mrcOnLine.RecordCount
    End If
End Sub

下机代码

Private Sub cmdOffLine_Click()
 
Dim MsgText As String
Dim StuSQL As String
Dim OnLineSQL As String
Dim BasicDataSQL As String
Dim LineSQL As String
Dim mrcStu As ADODB.Recordset
Dim mrcOnLine As ADODB.Recordset
Dim mrcBasicData As ADODB.Recordset
Dim mrcLine As ADODB.Recordset
   
    '判断卡号是否为空
    If Trim(txtCardNo.Text = "") Then
        MsgBox "请输入卡号！", vbOKOnly + vbInformation, "温馨提示"
        txtCardNo.SetFocus
        Exit Sub
    End If
   
    '判断卡号是否为数字
    If Not IsNumeric(txtCardNo.Text) Then
        MsgBox "请输入数字！", vbOKOnly + vbInformation, "温馨提示"
        txtCardNo.Text = ""
        txtCardNo.SetFocus
        Exit Sub
    End If
   
    '判断卡号是否存在
    StuSQL = "select * from student_info where cardno='" & txtCardNo.Text & "'"
    Set mrcStu = ExecuteSQL(StuSQL, MsgText)
    If mrcStu.EOF = True Then
        MsgBox "您输入的卡号还未注册，请先注册！", 48, "警告"
        txtCardNo.Text = ""
        txtCardNo.SetFocus
        Exit Sub
    End If
   
    '判断该卡是否正在上机
    OnLineSQL = "select * from OnLine_info where cardno='" & txtCardNo.Text & "'"
    Set mrcOnLine = ExecuteSQL(OnLineSQL, MsgText)
    If mrcOnLine.EOF = True Then
        MsgBox "该卡未上机，请先上机再下机！", 48, "警告"
        txtCardNo.Text = ""
        txtCardNo.SetFocus
        Exit Sub
    Else
        txtCardNo.Text = mrcOnLine.Fields(0)
        txtType.Text = mrcOnLine.Fields(1)
        txtSID.Text = mrcOnLine.Fields(2)
        txtName.Text = mrcOnLine.Fields(3)
        txtDept.Text = mrcOnLine.Fields(4)
        comboSex.Text = mrcOnLine.Fields(5)
        txtOnDate.Text = mrcOnLine.Fields(6)
        txtOnTime.Text = mrcOnLine.Fields(7)
        txtOffTime.Text = Time
        txtOffDate.Text = Format(Date, "yyyy-mm-dd")
        
        '在线时长计算
        linetime = (Date - DateValue(mrcOnLine!ondate)) * 1440 + (Hour(Time) - Hour(TimeValue(mrcOnLine!OnTime))) * 60 + (Minute(Time) - Minute(TimeValue(mrcOnLine!OnTime))) '时间单位为分钟
                         
        '计算消费金额;消费时间小于准备时间，则消费金额为0
        BasicDataSQL = "select * from basicdata_info "
        Set mrcBasicData = ExecuteSQL(BasicDataSQL, MsgText)
    
        If Trim(linetime) <= Val(mrcBasicData.Fields(4)) Then
           txtCMoney.Text = 0
           txtCTime.Text = 0
        Else
           consumetime = Val(linetime) - Val(mrcBasicData.Fields(4))
           txtCTime.Text = linetime
           If Trim(txtType.Text) = "固定用户" Then
                txtCMoney.Text = Format(consumetime / mrcBasicData.Fields(2) * mrcBasicData.Fields(0), "0.00")
           Else
                txtCMoney.Text = Format(consumetime / mrcBasicData.Fields(2) * mrcBasicData.Fields(1), "0.00")
           End If
        End If
   
        '计算余额
        txtCash.Text = Val(mrcStu.Fields(7)) - Val(Trim(txtCMoney.Text))
        
        '将余额更新到student表中
        mrcStu.Fields(7) = Val(Trim(txtCash.Text))
        mrcStu.Update
        mrcStu.Close
    End If
       
    '删除line表中上机的信息
    LineSQL = "select * from line_info where cardno='" & txtCardNo.Text & "'"
    Set mrcLine = ExecuteSQL(LineSQL, MsgText)
    mrcLine.Delete
    mrcLine.Update
    mrcLine.Close
    
    '更新Line表
    LineSQL = "select * from line_info where cardno='" & txtCardNo.Text & "'"
    Set mrcLine = ExecuteSQL(LineSQL, MsgText)
    With mrcLine
        .AddNew
        .Fields(1) = Trim(txtCardNo.Text)
        .Fields(2) = Trim(txtSID.Text)
        .Fields(3) = Trim(txtName.Text)
        .Fields(4) = Trim(txtDept.Text)
        .Fields(5) = Trim(comboSex.Text)
        .Fields(6) = mrcOnLine!ondate
        .Fields(7) = mrcOnLine!OnTime
        !COMPUTER = VBA.Environ("computername")
        !offdate = Trim(txtOffDate.Text)
        !offtime = Trim(txtOffTime.Text)
        !consumetime = Trim(txtCTime.Text)
        !consume = Trim(txtCMoney.Text)
        !cash = Trim(txtCash.Text) & ""
        !Status = "正常下机"
        .Update
        .Close
    End With
    
      '更新online表
    mrcOnLine.Delete
    mrcOnLine.Update
    mrcOnLine.Close

    '显示正在上机的人数
    OnLineSQL = "select * from OnLine_Info"
    Set mrcOnLine = ExecuteSQL(OnLineSQL, MsgText)
    If mrcOnLine.EOF = True Then
        lblAmount.Caption = 0
    Else
        lblAmount.Caption = mrcOnLine.RecordCount
    End If
End Sub