学生上机后，都会有一个扣费的过程，之前做这个的时候，想得很简单，就是下机时间减去上机时间，所得时间差就是上机消耗的时间，这里边有个漏洞就是，如果学生更改系统时间，结账后消耗金额就会为负数，总不能倒找钱吧！于是我改进了我的上机扣费程序，添加了一个Timer控件，每隔多少分钟扣费一次，大概的流程是这样的：

代码如下：

<pre name="code" class="html">Private Sub DisTimer_Timer() '设置每分钟执行一次
    Dim mrcc As ADODB.Recordset
    Dim tsql As String,tMSG As String
    '上机表
    tsql = "select*from online_info"
    Set mrcc = Executesql(tsql,tMSG)
    
    Do While Not mrcc.EOF '对所有学生执行一遍
    '基础数据表
        txtsql = "select*from basicdata_info"
        Set mrc = Executesql(txtsql,MsgText)
        
    '判断有无上机学生
        If mrcc.EOF Then
            Exit Sub
        End If
        
    '消费时间，每分钟加一
        DisTime = DisTime + 1
        
    '判断收费类型
        'DisTime<准备时间
        If DisTime <= Val(Trim(mrc.Fields(4))) Then
            mrcc.Fields(10) = 0
        End If
        
        '准备<DisTime<优惠
        If Val(Trim(mrc.Fields(4))) < DisTime <= Val(Trim(mrc.Fields(3))) Then
            mrcc.Fields(10) = 1 '可改为收取正常收费时的一半
        End If
        
        'DisTime>优惠时间:正常收费
        If DisTime > Val(Trim(mrc.Fields(3))) Then
            If T = 1 Then 'T用来循环
                mrcc.Fields(10) = Val(Trim(mrcc.Fields(10))) + Val(Trim(mrcc.Fields(12)))
            Else
                If T >= Val(Trim(mrc.Fields(3))) Then
                    T = 0
            End If
            T = T + 1
        End If
 
'判断余额是否充足
        Dim STU As ADODB.Recordset
        Dim ssql As String,sText As String
         ssql = "select*from student_info where cardno='" & Trim(mrcc.Fields(0)) & "'"
        Set STU = Executesql(ssql,sText)
        If Val(Trim(STU.Fields(1))) < Val(Trim(mrcc.Fields(10))) Then
            txtCardNo.Text = mrcc.Fields(0)
            Call cmdDown_Click
        Else
            mrcc.Update
        End If
        mrcc.MoveNext
    Loop
End Sub