机房收费系统—上下机

原创 2016年08月29日 17:21:16

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


上机:其实很简单,就是将上机的信息更新到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


版权声明:本文为博主原创文章,未经博主允许不得转载。

《机房收费系统》 之 自动结账

上图是机房收费系统的主界面,其中包含了上机学生的信息!今天我来跟大家说说怎么让它实现当学生余额不足时自动下机的功能 实现这个功能,首先我们需要一个Timer控件,如下图所示: 图中...
  • u010786678
  • u010786678
  • 2013年11月24日 19:48
  • 2346

机房收费系统上下机小结

前言 上机 前言   敲了很久的机房,感觉自己还是有些地方做的不够,自己感觉的很好,但是却还是缺少很多东西,让璐璐帮我点了一遍机房,发现自己不足的地方还有很多,自己想不到的地方还有很多很...
  • Zhang_0507
  • Zhang_0507
  • 2017年12月03日 10:46
  • 124

机房收费系统之向表中插入NULL值,INSERT失败

在实现充值功能时,向数据库表中添加数据时,出现了这样的错误提示:                                                   也就是说在添加时没有向seria...
  • u010097777
  • u010097777
  • 2013年11月09日 21:13
  • 1172

机房收费系统之上机状态查看

前言:上机状态查看这块查询部分和之前的查询类似,不再多说; 下面来说下如何实现所有学生下线:1.如何实现所有学生下线: 我的思路是通过click事件将上机表中的online信息删除 所以显示全部...
  • xsh096011
  • xsh096011
  • 2017年11月28日 18:33
  • 153

第一次机房收费系统 “登录”

前言:说到登录我为啥,会写登录呢,按说不就个登录吗,怎么简单的东西有必要写一篇博客总结吗,有必要! 非常有必要 因为就在刚开始的时候这个非常简单的东西让我,整整的卡了三天为啥就一个登录就能卡我三天 。...
  • kangshihang1998
  • kangshihang1998
  • 2017年05月03日 14:30
  • 559

机房收费系统之结账

机房收费系统,结账部分为了简化计算,可以在相关表中添加需要的字段;sum和count的区别...
  • sun15732621550
  • sun15732621550
  • 2015年08月25日 22:34
  • 935

UML学习:机房收费系统-图集(协作,顺序,部署,构件)

前言通过之前的学习,对机房收费系统在用例需求以及功能上做了一些总结,借助UML模型图让这些东西更加清晰明了的呈现出来,这次我们就再深入的了解一下从其他几个角度来认识机房收费系统这个软件。机房收费系统-...
  • SugaryoTT
  • SugaryoTT
  • 2015年11月28日 23:02
  • 1474

【机房收费系统】上下机

敲机房已经有一段时间了,不能只敲不总结,
  • u013034793
  • u013034793
  • 2014年08月21日 12:27
  • 840

机房收费系统 之 上下机

我的上下机可以说是机房收费系统的最后的一部分。在敲上下机之前自己没有去理一理思路,用户是怎样上机的又是怎样下机的,只是听他们说比较难,所以有一点点畏惧的心理,所以一直拖延到了最后。其实,当自己静下心来...
  • zx15732623832
  • zx15732623832
  • 2015年09月05日 20:55
  • 371

机房收费系统上下机

前言        机房收费系统最关键的几个部分包括上下机,组合查询,结账。上下机这部分主要还是理逻辑关系,理清各个窗体之间的关系,还有表与表之间的关系。把基本功能实现之后,自己就会发现原来需要注意和...
  • Sophia_0331
  • Sophia_0331
  • 2018年01月01日 19:28
  • 53
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:机房收费系统—上下机
举报原因:
原因补充:

(最多只允许输入30个字)