机房收费之上下机

    刚开始敲上下机时觉得还比较难，主要还是没有缕清思路，没有明白自己要干嘛，所以就会有些盲目，通过下面这个流程图可以很清晰地知道自己每一步要怎么做，写代码的时候就简单了许多，上下机重要的部分还是和所花费的

钱算清楚了。

Private Sub shangji_Click()

Dim txtsql As String, txtSQL1 As String, txtSQL3 As String
Dim Msgtext As String
Dim mrc As ADODB.Recordset
Dim rst As ADODB.Recordset
Dim mrcc As ADODB.Recordset

    If txtcardno(0).Text = "" Then
    '判断卡号是否为空
        MsgBox "卡号不能为空", vbOKOnly + vbExclamation, "提示"
        txtcardno(0).SetFocus
        Exit Sub
    Else
        txtsql = "select * from student_info where cardno ='" & Trim(txtcardno(0).Text) & "'"
        Set mrc = ExecuteSQL(txtsql, Msgtext)
        txtSQL1 = "SELECT * from basicdata_info"
        Set rst = ExecuteSQL(txtSQL1, Msgtext)
        If mrc.EOF And mrc.BOF Then
         '判断卡号是否注册
            MsgBox "此卡号尚未注册！", vbOKOnly + vbExclamation, "提示"
            txtcardno(0).SelStart = 0   '返回或设置选择文本的起始位置
            txtcardno(0).SelLength = Len(txtcardno(0).Text)    '选中的长度
            txtcardno(0).SetFocus
            Exit Sub
        Else
             If Trim(mrc.Fields(10)) = "不使用" Then
             
                MsgBox "此卡已退，不能使用！", vbOKOnly + vbExclamation, "提示"
                txtcardno(0).SelStart = 0   '返回或设置选择文本的起始位置
                txtcardno(0).SelLength = Len(txtcardno(0).Text)    '选中的长度
                txtcardno(0).SetFocus
                Exit Sub
             Else
                  If mrc.Fields(7) < rst.Fields(5) Then
                  '判断余额是否充足
                    MsgBox "余额只有" & mrc.Fields(7) & ",少于最少金额，请先充值！", vbOKOnly, "警告!"
                    Exit Sub
                  Else
                  txtSQL3 = "select * from online_info where cardno='" & Trim(txtcardno(0).Text) & "'"
                  Set mrcc = ExecuteSQL(txtSQL3, Msgtext)
                  
                       If Not (mrcc.EOF And mrcc.BOF) Then
                           '判断此卡号是否正在上机
                           MsgBox "此卡号正在上机", vbOKOnly, "提示"
                           txtID(1).Text = mrc.Fields(1)
                           txtdepartment(2).Text = mrc.Fields(4)
                           txttype(3).Text = mrc.Fields(14)
                           txtName(4).Text = mrc.Fields(2)
                           txtsex(5).Text = mrc.Fields(3)
                           txtsdate(0).Text = mrcc.Fields(6)
                           StartDate = txtsdate(0).Text
                           txtamount(2).Text = mrc.Fields(7)
                           txtstime(3).Text = mrcc.Fields(7)
                           StartTime = txtstime(3).Text
                           txtxdate(1).Text = ""
                           txtxtime(4).Text = ""
                           txtconsumetime(5).Text = ""
                           txtconsumepay(6).Text = ""
                          
                           txtcardno(0).SelStart = 0   '返回或设置选择文本的起始位置
                           txtcardno(0).SelLength = Len(txtcardno(0).Text)    '选中的长度
                           txtcardno(0).SetFocus
                           Exit Sub
                        Else
                            '显示卡号的相关信息
                            txtID(1).Text = mrc.Fields(1)
                            txtdepartment(2).Text = mrc.Fields(4)
                            txttype(3).Text = mrc.Fields(14)
                            txtName(4).Text = mrc.Fields(2)
                            txtsex(5).Text = mrc.Fields(3)
                            StartDate = Date
                            txtsdate(0).Text = StartDate
                            txtamount(2).Text = mrc.Fields(7)
                            StartTime = Time
                            txtstime(3).Text = StartTime
                            txtxdate(1).Text = ""
                            txtxtime(4).Text = ""
                            txtconsumetime(5).Text = ""
                            txtconsumepay(6).Text = ""
                            Label1.Caption = "上机成功"
                            '把信息录入到 online_info表中
                            mrcc.AddNew
                            mrcc.Fields(0) = txtcardno(0).Text
                            mrcc.Fields(1) = txttype(3).Text
                            mrcc.Fields(2) = txtID(1).Text
                            mrcc.Fields(3) = txtName(4).Text
                            mrcc.Fields(4) = txtdepartment(2).Text
                            mrcc.Fields(5) = txtsex(5).Text
                            mrcc.Fields(6) = txtsdate(0).Text
                            mrcc.Fields(7) = txtstime(3).Text
                            mrcc.Fields(8) = VBA.Environ("computername")
                            mrcc.Fields(9) = Now
                            mrcc.Update        '更新数据库
                            mrcc.Close
                        End If
                   End If
             End If
         End If
    End If
     
End Sub

</pre><pre name="code" class="vb">Private Sub xiaji_Click()
Dim CostDate As Long, CostTime As Long, cash As Long
Dim alltime As Single                '上机时间
Dim consumemoney As Currency    '上机费用
Dim Rate, tmpRate, unittime, leasttime, preparetime
Dim txtsql As String, txtSQL1 As String, txtSQL2 As String, txtSQL3 As String
Dim Msgtext As String
Dim mrc As ADODB.Recordset
Dim rst As ADODB.Recordset
Dim mrcc As ADODB.Recordset
Dim line As ADODB.Recordset


    txtSQL1 = "select * from online_info where cardno='" & Trim(txtcardno(0).Text) & "'"
    Set mrc = ExecuteSQL(txtSQL1, Msgtext)                     '从数据库中选择卡号等于输入的卡号
    txtSQL2 = "select * from student_info"
    Set mrcc = ExecuteSQL(txtSQL2, Msgtext)
   
    
    If mrc.EOF And mrc.BOF Then
    '判断卡号是否在上机
        MsgBox "此卡号没有上机！", vbOKOnly, "提示"     '如果没有在上机，提示
        '信息为空
        txtID(1).Text = ""                                '学号为空
        txtdepartment(2).Text = ""
        txttype(3).Text = ""
        txtname(4).Text = ""
        txtsex(5).Text = ""
        txtsdate(0).Text = ""
        txtamount(2).Text = ""
        txtstime(3).Text = ""
        txtxdate(1).Text = ""
        txtxtime(4).Text = ""
        txtconsumetime(5).Text = ""
        txtconsumepay(6).Text = ""
        txtcardno(0).SetFocus
    Else
        '显示一些信息
        '下机日期和时间
        EndDate = Date
        EndTime = Time
        '显示此卡号上机时的信息
        txtID(1).Text = mrc.Fields(2)
        txtdepartment(2).Text = mrc.Fields(4)
        txttype(3).Text = mrc.Fields(1)
        txtname(4).Text = mrc.Fields(3)
        txtsex(5).Text = mrc.Fields(5)
        StartDate = mrc.Fields(6)
        txtsdate(0).Text = StartDate
        txtamount(2).Text = mrcc.Fields(7)
        StartTime = mrc.Fields(7)
        txtstime(3).Text = StartTime
       
        '计算消费时间
        CostDate = DateDiff("n", StartDate, EndDate) '日期差返回分钟数
        CostTime = DateDiff("n", StartTime, EndTime)    '时间差返回分钟数
        alltime = CostDate + CostTime '使用时间为多少分钟
        
        txtsql = "select * from basicdata_info"
        Set rst = ExecuteSQL(txtsql, Msgtext)
        
        '把数据库的值赋给各个字段
        Rate = rst.Fields(0)
        tmpRate = rst.Fields(1)
        unittime = rst.Fields(2)
        leasttime = rst.Fields(3)
        preparetime = rst.Fields(4)
       
        '收费情况
        If alltime <= preparetime Then
           consumemoney = 0
        Else
            If alltime <= leasttime Then
               consumemoney = Val(Rate / 2)
            Else
                If txttype(3).Text = "固定用户" And alltime <= unittime Then
                   consumemoney = Val(Rate)
                   
                ElseIf txttype(3).Text = "固定用户" And alltime > unittime Then
                    consumemoney = Val(Rate * Int(alltime / 60 + 1))
                
                ElseIf txttype(3).Text = "临时用户" And alltime <= unittime Then
                    consumemoney = Val(tmpRate)
                ElseIf txttype(3).Text = "临时用户" And alltime < unittime Then
                    consumemoney = Val(tmpRate * Int(alltime / 60 + 1))
               End If
            End If
        End If

        txtxdate(1).Text = EndDate
        txtxtime(4).Text = EndTime
        txtconsumetime(5).Text = alltime
        txtconsumepay(6).Text = consumemoney
        cash = txtamount(2).Text - consumemoney
        txtamount(2).Text = cash  '更新金额
        '数据库student_info中金额也更新
      
        mrcc.Fields(7) = txtamount(2).Text
        mrcc.Update
        mrcc.Close
        '删除online_info中记录
        mrc.Delete
        mrc.Update
        '往line_info中添加记录
        txtSQL3 = "select * from line_info"
        Set line = ExecuteSQL(txtSQL3, Msgtext)
        line.AddNew
        line.Fields(1) = txtcardno(0).Text
        line.Fields(2) = txtID(1).Text
        line.Fields(3) = txtname(4).Text
        line.Fields(4) = txtdepartment(2).Text
        line.Fields(5) = txtsex(5).Text
        line.Fields(6) = StartDate
        line.Fields(7) = StartTime
        line.Fields(8) = EndDate
        line.Fields(9) = EndTime
        line.Fields(10) = alltime
        line.Fields(11) = consumemoney
        line.Fields(12) = cash
        line.Fields(13) = "正常下机"
        line.Fields(14) = VBA.Environ("computername")
        line.Update
        line.Close
        MsgBox "下机成功！", vbOKCancel, "提示"
        '清空信息
        txtID(1).Text = ""
        txtdepartment(2).Text = ""
        txttype(3).Text = ""
        txtname(4).Text = ""
        txtsex(5).Text = ""
        StartDate = ""
        txtsdate(0).Text = ""
        txtamount(2).Text = ""
        txtstime(3).Text = ""
        txtxdate(1).Text = ""
        txtxtime(4).Text = ""
        txtconsumetime(5).Text = ""
        txtconsumepay(6).Text = ""
        txttime.Text = ""
        txtnumber.Text = ""
        txtcardno(0).SetFocus
        txtcardno(0).Text = ""
        Label1.Caption = ""
 End If
End Sub