机房收费系统—上下机

原创 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


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

相关文章推荐

机房收费系统—上下机

机房收费系统一共涉及到4种身份的人,分别是学生、一般用户、操作员、管理员。其中只有学生是不能进行直接进行上下机的操作的,他需要到其他3者身份的那个人那去刷一下卡。下面来说一下具体的思路吧,如果您有什么...

机房收费系统—软件需求说明书

1引言... 2 1.1编写目的... 2 1.2背景... 2 1.3定义... 2 1.4参考资料... 2 2任务概述... 2 2.1目标... 2 2.2用户的特点... 3 2.3假定和约...

重构机房收费系统—浅谈三层

机房收费系统重构,详细说明重构各个层的由来以及构建建议。

机房收费系统—注册 实时错误“-2147217873(80040e2f)”

今天敲机房的时候,注册代码刚敲好,一运行,就出现了如下错误。         【分析原因】 NULL空值,实际上有三种情况:占位空值,即对象的属性不存在,无意义;未知空值,即对象有属性,存在...

机房收费系统—美化

做第二遍机房收费的时候,发现美化的界面是个细致活,做的时候简直是绞尽脑汁呀。做完了后才知道,其实小小的美化其实也是很要技术的。 第一、窗体最小化      我们做的时候,发现机房收费系统最小化窗体时,...

机房收费系统—初始报表

在学习机房之前,我是没有接触过报表的,对它一窍不通,后来结果问度娘,算是对其了解了一点点。 一、报表的概念 报表即向上级报告情况的表格。简单的说:报表就是用表格、图表等格式来动态显示数据,可以用公...

重构机房收费系统—数据库设计

机房收费系统三范式和ER图。

第一次机房收费系统—宏观认识

前言:        机房收费系统是我们接触的第一个没有源码的项目,这就是开始考验我们独立思考的阶段了。汲取了之前做学生信息管理系统的经验,这次开始之前就做了个全局的导图,方便过程中的知识梳理。 ...

机房收费系统—导出Excel表

学习机房学到的其中一个新的知识点就是导出Excel表,这个知识点是以前没有接触过的。也许是因为在机房这里接触到的新的知识多了,也许是因为自己对导出Excel比较感兴趣,所以当遇到这个知识点的时候,自己...

机房收费系统模块篇—Split函数、InStr函数

机房收费系统模块部分之Split & InStr
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:深度学习:神经网络中的前向传播和反向传播算法推导
举报原因:
原因补充:

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