机房收费系统—上下机

机房收费系统这部分最重要的就是算钱了,理清了算钱就差不多了。


上机:其实很简单,就是将上机的信息更新到OnLine、Line表中


Private Sub cmdOnwork_Click()
    Dim txtSQL As String   '查询student_info,判断卡号是否注册
    Dim txtSQL2 As String  '查询online_info,判断卡号是否正在上机
    Dim txtSQL4 As String   '查询basicdata_info中的limitcash
    Dim txtSQL5 As String   '将该卡上机的信息填入到online_info表中
    Dim txtSQL6 As String   '查询正在上机的人数
    Dim txtSQL7 As String
    Dim msgText As String
    Dim MsgText2 As String
    Dim MsgText4 As String
    Dim MsgText5 As String
    Dim MsgText6 As String
    Dim MsgText7 As String

    Dim mrc As ADODB.Recordset
    Dim mrc2 As ADODB.Recordset
    Dim mrc4 As ADODB.Recordset
    Dim mrc5 As ADODB.Recordset
    Dim mrc6 As ADODB.Recordset
    Dim mrc7 As ADODB.Recordset
    
'重新登录时,刷新
    serial.Text = ""
    studentNo.Text = ""
    studentName.Text = ""
    department.Text = ""
    sex.Text = ""
    onDate.Text = ""
    OnTime.Text = ""
    offDate.Text = ""
    offTime.Text = ""
    consumeTime.Text = ""
    consumecash.Text = ""
    remainCash.Text = ""


    '判断卡号是否为空
    If Trim(cardNo.Text) = "" Then
        MsgBox "请输入卡号!", vbOKOnly + vbExclamation, "提示"
        cardNo.SetFocus
        Exit Sub
    Else
        '判断卡号是否为数字
        If IsNumeric(cardNo.Text) = False Then
            MsgBox "卡号必须输入数字!", vbOKOnly + vbExclamation, "提示"
            cardNo.Text = ""
            cardNo.SetFocus
           Exit Sub
        End If
        
     txtSQL = "select * from student_Info where cardno= '" & Trim(cardNo.Text) & "'"
     Set mrc = ExecuteSQL(txtSQL, msgText)

        '判断该卡号是否注册
        If mrc.BOF And mrc.EOF Then
            MsgBox "该卡号未注册,请先注册信息!", vbOKOnly + vbExclamation, "提示"
            cardNo.Text = ""
            cardNo.SetFocus
            Exit Sub
        Else
              '判断卡号是否已经退卡,退卡后不能上机
           If Trim(mrc.Fields(10)) = "不使用" Then
               MsgBox "该卡已经退卡", vbOKCancel + vbInformation, "提示"
                cardNo.Text = ""
                cardNo.SetFocus
                Exit Sub
            Else
             '查询basicdata_info中的limitcash
                txtSQL4 = "select * from BasicData_info"
                Set mrc4 = ExecuteSQL(txtSQL4, MsgText4)
                mrc4.MoveFirst  '调取最新的那条数据

                If Val(mrc.Fields(7)) < Val(mrc4.Fields(5)) Then
                    MsgBox "余额不足,请充值后上机!", vbOKOnly + vbExclamation, "提示"
                    cardNo.Text = ""
                    cardNo.SetFocus
                    Exit Sub

                Else

                    '判断卡号是否正在上机
                    txtSQL2 = "select * from online_info where cardno='" & Trim(cardNo.Text) & "'"
                    Set mrc2 = ExecuteSQL(txtSQL2, MsgText2)

                    If mrc2.EOF = False Then
                        MsgBox "该卡正在上机,不能重复上机!"
                        cardNo.Text = mrc2.Fields(0)
                        studentNo.Text = mrc2.Fields(2)
                        studentName.Text = mrc2.Fields(3)
                        sex.Text = mrc2.Fields(5)
                        department = mrc.Fields(4)
                        serial.Text = mrc2.Fields(1)
                        onDate.Text = mrc2.Fields(6)
                        OnTime.Text = mrc2.Fields(7)
                        Exit Sub
                    Else
                        '查询student_info中的cash
                        txtSQL = "select * from student_info where cardno='" & Trim(cardNo.Text) & "'"
                        Set mrc = ExecuteSQL(txtSQL, msgText)

                       '显示该卡号的一些基本信息
                       studentNo.Text = mrc.Fields(1)
                       studentName.Text = mrc.Fields(2)
                       sex.Text = mrc.Fields(3)
                       department = mrc.Fields(4)
                       serial.Text = mrc.Fields(14)
                       onDate.Text = Date
                       OnTime.Text = Time
                   End If
              

                    '将该卡上机的信息填入到online_info表中

                    txtSQL5 = "select * from online_info"
                    Set mrc5 = ExecuteSQL(txtSQL5, MsgText5)

                    mrc5.AddNew
                    mrc5.Fields(0) = Trim(cardNo.Text)
                    mrc5.Fields(1) = serial.Text
                    mrc5.Fields(2) = studentNo.Text
                    mrc5.Fields(3) = studentName.Text
                    mrc5.Fields(4) = department.Text
                    mrc5.Fields(5) = sex.Text
                    mrc5.Fields(6) = Date
                    mrc5.Fields(7) = Time
                    mrc5.Fields(8) = Trim(Environ("computername"))

                    mrc5.Update
                    mrc5.Close
                    
                    '更新line表
                    txtSQL7 = "select * from line_info where cardno= '" & Trim(cardNo.Text) & "'"
                    Set mrc7 = ExecuteSQL(txtSQL7, MsgText7)
                      mrc7.AddNew
                      mrc7.Fields(1) = Trim(cardNo.Text)
                      mrc7.Fields(2) = Trim(studentNo.Text)
                      mrc7.Fields(3) = Trim(studentNo.Text)
                      mrc7.Fields(4) = Trim(department.Text)
                      mrc7.Fields(5) = Trim(sex.Text)
                      mrc7.Fields(6) = Trim(onDate.Text)
                      mrc7.Fields(7) = Trim(OnTime.Text)
                      mrc7.Fields(12) = Trim(mrc.Fields(7))
                      mrc7.Fields(13) = "正常上机"
                      mrc7.Fields(14) = Trim(Environ("computername"))
                      mrc7.Update

                    '查询正在上机的人数
                    txtSQL6 = "select * from online_info"
                    Set mrc6 = ExecuteSQL(txtSQL6, MsgText6)

                    If mrc6.EOF = True Then
                        people.Text = 0
                    Else
                        people.Text = mrc6.RecordCount
                    End If

               End If

           End If
        End If
    End If
End Sub
下机:其实也没有想象中的那么难,把钱理清楚了,也就简单了。


Private Sub cmdOffwork_Click()

Dim txtSQL As String
Dim msgText As String
Dim mrc As ADODB.Recordset
Dim mrc1 As ADODB.Recordset
Dim mrc2 As ADODB.Recordset
Dim mrc3 As ADODB.Recordset

Dim intLineTime As Integer '用于存储实际在线时间
Dim intconsume As Single
Dim curConsume As Single '用于存储真正花费钱的时间
Dim curBalance As Single '用于存储用户的余额
Dim fixedunit '用于存储单位金额
Dim temunit As Single '用于存储单位金额
Dim a As Integer
'判断是否为空
If Trim(cardNo.Text) = "" Then
    MsgBox "请输入卡号", vbOKOnly + vbExclamation, "警告"
    cardNo.SetFocus
    Exit Sub
Else
    If IsNumeric(cardNo.Text) = False Then
        MsgBox "卡号必须为数字", vbOKOnly + vbExclamation, "警告"
        cardNo.SetFocus
        cardNo.Text = ""
        Exit Sub
    Else
        '判断卡号是否注册
        txtSQL = "select*from student_Info where cardno = '" & Trim(cardNo.Text) & "'"
        Set mrc = ExecuteSQL(txtSQL, msgText)
    
        If mrc.EOF = True Then
            MsgBox "该卡号未注册,请先注册信息", vbOKOnly + vbExclamation, "警告"
            cardNo.Text = ""
            cardNo.SetFocus
            Exit Sub
            
        Else
            If mrc.Fields(10) = "不使用" Then
                MsgBox "该卡已经退卡,不能进行下机处理", vbOKOnly + vbExclamation, "警告"
                cardNo.Text = ""
                cardNo.SetFocus
                Exit Sub
            
            Else
            '判断该卡号是否上机
                txtSQL = "select * from onLine_Info where cardno='" & Trim(cardNo.Text) & "'"
                Set mrc1 = ExecuteSQL(txtSQL, msgText)
            
                If mrc1.EOF = True Then
                    MsgBox "该卡没有上机,不能进行下机处理", vbOKOnly + vbExclamation, "警告"
                    cardNo.Text = ""
                    cardNo.SetFocus
                    Exit Sub
                End If
            End If
        End If
    End If
End If
    
    '基本数据表,获得基本数据
    txtSQL = "select * from BasicData_Info"
    Set mrc2 = ExecuteSQL(txtSQL, msgText)
    mrc2.MoveFirst '调取数据库中最新更新的那条数据
    
    '计算消费时间(实际消费时间)
    intLineTime = (Date - DateValue(mrc1!onDate)) * 1440 + (Hour(Time) - Hour(TimeValue(mrc1!OnTime))) * 60 + (Minute(Time) - Minute(TimeValue(mrc1!OnTime))) '时间单位为分钟
    
    '单位时间的费用 (把固定用户,临时用户单位时间的费用分别赋值给费用)
    fixedunit = Val(mrc2.Fields(0)) '把固定用户的金额赋值给变量
    temunit = Val(mrc2.Fields(1)) '把临时用户的金额赋值给变量
    
    '判断在线时间是否小于准备时间,若小于则 消费金额=0
    If intLineTime <= Val(Trim(mrc2.Fields(4))) Then
        consumecash.Text = 0
    Else
        '判断在线时间是否小于最低消费时间,若小于则为0
        If intLineTime < Val(Trim(mrc2.Fields(3))) Then
            consumecash.Text = 0
        Else

            '在线时间大于单位时间,就按有几个单位时间算,分为固定用户和临时用户
            If intLineTime >= Val(Trim(mrc2!leasttime)) And intLineTime And Trim(mrc.Fields(14)) = "固定用户" Then
                a = Int(intLineTime / Val(Trim(mrc2!unittime)))
                If a = intLineTime / Trim(mrc2!unittime) Then
                    curConsume = a
                Else
                    curConsume = a + 1
                End If
                consumecash.Text = Val(curConsume) * Val(fixedunit)
            Else
                If intLineTime >= Val(Trim(mrc2!leasttime)) And intLineTime And Trim(mrc.Fields(14)) = "临时用户" Then
                    a = Int(intLineTime / Val(Trim(mrc2!unittime)))
                    If a = intLineTime / Trim(mrc2!unittime) Then
                        curConsume = a
                    Else
                        curConsume = a + 1
                    End If
                    consumecash.Text = Val(curConsume) * Val(temunit)
                End If
            
            End If
        End If
    End If

    '计算余额
    remainCash = mrc!cash - Val(consumecash.Text)
    
    '下机显示
    offDate.Text = Date
    offTime.Text = Time
    serial.Text = Trim(mrc1.Fields(1))
    studentNo.Text = Trim(mrc1.Fields(2))
    studentName.Text = Trim(mrc1.Fields(3))
    department.Text = Trim(mrc1.Fields(4))
    sex.Text = Trim(mrc1.Fields(5))
    onDate.Text = Trim(mrc1.Fields(6))
    OnTime.Text = Trim(mrc1.Fields(7))
    consumeTime.Text = intLineTime
    remainCash.Text = remainCash
    MsgBox "下机成功,欢迎下次再来", vbOKOnly + vbExclamation, "警告"
    
    '更新学生表
    mrc.Fields(7) = remainCash
    mrc.Update
    mrc.Close
    
    '更新上机记录表
    txtSQL = "select * from Line_Info"
    Set mrc3 = ExecuteSQL(txtSQL, msgText)

    mrc3.Fields(8) = Trim(offDate.Text)
    mrc3.Fields(9) = Trim(offTime.Text)
    mrc3.Fields(10) = Trim(consumeTime.Text)
    mrc3.Fields(11) = Trim(consumecash.Text)
    mrc3.Fields(12) = Trim(remainCash.Text)
    mrc3.Fields(13) = "正常下机"
    
    mrc3.Update
    
    '删除在线表的信息
    txtSQL = "select * from onLine_Info where cardno='" & Trim(cardNo.Text) & "'"
    Set mrc1 = ExecuteSQL(txtSQL, msgText)
    
    mrc1.Delete
    mrc1.Update
    
    people.Text = Str(people.Text - 1)
      
    
End Sub


阅读更多
版权声明:本文为博主原创文章,未经博主允许不得转载。 https://blog.csdn.net/n950814abc/article/details/52355034
所属专栏: 机房收费系统
想对作者说点什么? 我来说一句

没有更多推荐了,返回首页

不良信息举报

机房收费系统—上下机

最多只允许输入30个字

加入CSDN,享受更精准的内容推荐,与500万程序员共同成长!
关闭
关闭