机房收费系统之动态刷新下机

前言

在网吧上网,卡里没钱就要系统强制下机.怎么办?

这是我用到timer1控件,
timer1重要的属性是Interval.但lnterval有范围限制,不过我可以通过函数来调节大小.在这里不用,你可以随便什么时候刷新.

我还用到动态数组Redim
Redim :在有些时候不知道需要多大的数组，就可以使用一个能改变大小的数组，就是动态数组，redim是很方便，灵活的可以随时改变大小的数组。有效管理内存，可以将内存空间释放给系统，大大节省内存，提高运行速度。

我的刷新下机代码

 Private Sub Timer1_Timer()
  Dim i, cardno As Integer
  Dim txtsql, msgtext As String
  Dim mrcba, mrcon, mrc1, mrcstudent As ADODB.Recordset
  Dim intConsumetime, cmoney, newcash, pastcash, fixusercharge, temusercharge As Integer
  
  txtsql = "select * from basicdata_info"
  Set mrcba = ExecuteSQL(txtsql, msgtext)
  
  txtsql = "select * from student_info"
  Set mrcstudent = ExecuteSQL(txtsql, msgtext)
  
  txtsql = "select * from 0nline_info"
  Set mrcon = ExecuteSQL(txtsql, msgtext)
  
  txtsql = "select * from line_info"
  Set mrc1 = ExecuteSQL(txtsql, msgtext)
  '当online表没有数据时直接跳出此过程
  If mrcon.EOF And mrcon.BOF Then
       Timer1.Enabled = False
       Exit Sub
  End If
  fixusercharge = mrcba.Fields(0)  '固定用户的单位费用
  temusercharge = mrcba.Fields(1)  '临时用户的单位费用
  pastcash = mrcstudent.Fields(7)  '获得原金额
   '将上机卡号定义为一个数组
  ReDim a(mrcon.RecordCount) As String
  For i = 0 To mrcon.RecordCount - 1
  a(i) = Trim(mrcon!cardno)
  cardno = a(i)
  
  txtsql = "select * from online_info where cardno='" & Trim(cardno) & "'"
  Set mrcon = ExecuteSQL(txtsql, msgtext)
  intConsumetime = DateDiff("n", mrcon.Fields(10), Now)    '计算时间
  
  If mrcon!card = "固定用户" Then
        cmoney = Int(intConsumetime / 60 + 1) * fixusercharge
        newcash = pastcash - cmoney
        '判断金额是否充足
        If (newcash > 0) And (newcash <= Val(mrcba!LimitCash)) Or (newcash < 0) Then
        txtsql = "delete * from online_info where cardno = '" & cardno & "'"
        Set mrcon = ExecuteSQL(txtsql, msgtext)
        MsgBox "卡号：" & cardno & ",余额不足，即将下机！", 48, "警告"
        mrcstudent!cash = newcash
        mrcstudent.Update
        txtconsume.Text = cmoney
        txtcash.Text = newcash
        Call viewdata
        Exit Sub
        End If
  Else
       cmoney = Int(intConsumetime / 60 + 1) * temusercharge
       newcash = pastcash - cmoney
       '判断金额是否充足
       If (newcash > 0) And (newcash <= Val(mrcba!LimitCash)) Or (newcash < 0) Then
        txtsql = "delete * from online_info where cardno = '" & cardno & "'"
        Set mrcon = ExecuteSQL(txtsql, msgtext)
        MsgBox "卡号：" & cardno & ",余额不足，即将下机！", 48, "警告"
        mrcstudent!cash = newcash
        mrcstudent.Update
        txtconsume.Text = cmoney
        txtcash.Text = newcash
        Call viewdata
        Exit Sub
        End If
  End If
End Sub

Private Sub viewdata()
    txtcardno.Text = mrc1.Fields(0)
    txtstudentno.Text = mrc1!studentno
    txtdepartment.Text = mrc1!department
    txttype.Text = mrc1!Type
    txtname.Text = mrc1!studentname
    txtsex.Text = mrc1!sex
    txtondate.Text = mrc1!ondate
    txtontime.Text = mrc1!OnTime
    txtoffdate.Text = Date
    txtofftiem.Text = Time
    txtconsumetime.Text = intConsumetime
    mrc1!offdate = Date
    mrc1!offtime = Time
    mrc1!consumetime = intConsumetime
      mrc1.Update
    End Sub