机房收费系统之上下机

  何为上下机呢?就像你去网吧上网,你要上机之后才可以上网,下机就是你准备离开网吧,需要对你上机的时间进行结算,结账成功,你就可以下机了。

  上机:

If Not Testtxt(txtCardno.Text) Then '防止输入框为空
        MsgBox "卡号为空!", vbOKOnly + vbExclamation, "警告"
        txtCardno.SetFocus
        Exit Sub
    End If
    
     If Not IsNumeric(Trim(txtCardno.Text)) Then '防止输入框为空
        MsgBox "请输入数字!", vbOKOnly + vbExclamation, "警告"
        txtCardno.SetFocus
        Exit Sub
    End If
    '判断卡号是否存在,判断此卡是否正在上机
    txtSQL = "select * from student_info where cardno='" & Trim(txtCardno.Text) & "'" 'And "status= '" & 使用 & "'"""
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    
    '寻找基本数据里面最少上机金额
    txtSQL3 = "select * from basicdata_info "
    Set mrc3 = ExecuteSQL(txtSQL3, MsgText)
    
    If mrc.EOF Then
        MsgBox "此卡号尚未注册"
        txtCardno.Text = ""
        txtCardno.SetFocus
    Else
        '判断余额是否充足,如果充足执行下面的语句,如果不充足提示充值
        If mrc.Fields(7) < mrc3.Fields(5) Then
            MsgBox "余额不太多了,请先充值再上机!", vbOKOnly + vbExclamation, "温馨提示"
            frmRecharge.Show
            Exit Sub
        End If
            
        txtsql1 = "select * from online_info where cardno='" & Trim(txtCardno.Text) & "'" 'And "status= '" & 使用 & "'"""
        Set mrc1 = ExecuteSQL(txtsql1, MsgText)
        '往line表里更新数据
        txtSQL2 = "select * from line_info"
        Set mrc2 = ExecuteSQL(txtSQL2, MsgText)
        
            If mrc1.EOF Then
                txttype.Text = mrc.Fields(14)
                txtstudentno.Text = mrc.Fields(1)
                txtName.Text = mrc.Fields(2)
                txtSex.Text = mrc.Fields(3)
                txtdepartment.Text = mrc.Fields(5)
                txtsjdate.Text = mrc.Fields(12)
                txtsjtime.Text = mrc.Fields(13)
                mrc1.AddNew
                mrc1.Fields(0) = txtCardno.Text
                mrc1.Fields(1) = txttype.Text
                mrc1.Fields(2) = txtstudentno.Text
                mrc1.Fields(3) = txtName.Text
                mrc1.Fields(4) = txtdepartment.Text
                mrc1.Fields(5) = txtSex.Text
                mrc1.Fields(6) = txtsjdate.Text
                mrc1.Fields(7) = txtsjtime.Text
                mrc1.Fields(8) = VBA.Environ("computername")
                mrc1.Fields(9) = Now '数据库里面既包含日期有包含时间那就是now了
                mrc1.Update
                mrc2.AddNew
                mrc2.Fields(1) = txtCardno.Text
                mrc2.Fields(2) = txtstudentno.Text
                mrc2.Fields(3) = txtName.Text
                mrc2.Fields(4) = txtdepartment.Text
                mrc2.Fields(5) = txtSex.Text
                mrc2.Fields(6) = txtsjdate.Text
                mrc2.Fields(7) = txtsjtime.Text
                mrc2.Fields(11) = "0"
                mrc2.Fields(12) = mrc.Fields(7) '把student_info表里面的信息放到line表里面
                mrc2.Fields(13) = "正常上机"
                mrc2.Fields(14) = VBA.Environ("computername")
                mrc2.Update
            Else
                MsgBox "此卡正在上机!"
                txttype.Text = mrc1.Fields(1)
                txtstudentno.Text = mrc1.Fields(2)
                txtName.Text = mrc1.Fields(3)
                txtdepartment.Text = mrc1.Fields(4)
                txtSex.Text = mrc1.Fields(5)
                txtsjdate.Text = mrc1.Fields(6)
                txtsjtime.Text = mrc1.Fields(7)
            End If

下机:下面我把下机里边比较有意思的代码展示给大家,大家知道有普通用户和VIP,他们每个小时的价格是不一样的。

  

 Dim M As Date
        M = Format(Now(), "yyyy-mm-dd hh:mm:ss")
        t = DateDiff("n", mrc3.Fields(9), M) 'datediff函数来取时间
        '判断上机时间的长短
        If t < tprepare Then
            t1 = 0  '时间小于准备时间的时间按零算
        Else
        If t < tleasttime Then
            t1 = tleasttime / 60 '小于最小时间的按最小时间算
        Else
         If t Mod 60 = 0 Then
             t1 = Int(t / 60) '如果整除的话就按整点算
        Else
             t1 = Int(t / 60) + 1 '如果不能整除就取整加一
        End If
            End If
        End If
        '时间已经有了就差计算金钱了
        
        '判断用户类型
        If mrc1.Fields(14) = "固定用户" Then
            money = t1 * mrate
        Else
            money = t1 * mtmprate
        End If

   仅供大家参考,希望对大家有帮助。

猜你喜欢

转载自blog.csdn.net/qq2263796380/article/details/81406987