机房系统上机与下机

• 主动下机代码

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 online_info"   '建立Online表的连接，判断是否有正在上机的卡号
    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)
  '当online表没有数据时直接跳出此过程
  If mrcon.EOF And mrcon.BOF Then
       Timer1.Enabled = False
  End If
         '计算时间
  intConsumetime = Trim(DateDiff("n", mrcon.Fields(9), Now))
  If mrcon!cardtype = "固定用户" 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
        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
        End If
  End If
  Next i
End Sub

• 子程序

Private Sub viewdata() Dim txtsql, msgtext As String
Dim mrc1, mrcon As ADODB.Recordset
Dim intConsumetime As Integer
txtsql = "select * from line_info "
Set mrc1 = ExecuteSQL(txtsql, msgtext)
txtsql = "select * from online_info "
Set mrcon = ExecuteSQL(txtsql, msgtext)
txtcardno.Text = mrc1.Fields(0)
txtstudentno.Text = mrc1!studentno
txtdepartment.Text = mrc1!department
txttype.Text = mrcon!cardtype
txtname.Text = mrc1!studentname
txtsex.Text = mrc1!sex
txtondate.Text = mrc1!ondate
txtontime.Text = mrc1!OnTime
txtoffdate.Text = Date
txtofftime.Text = Time
txtconsumetime.Text = intConsumetime
mrc1!offdate = Date
mrc1!offtime = Time
mrc1!consumetime = intConsumetime
mrc1.Update
End Sub

• 下机代码

Private Sub Command2_Click()
Dim txtsql, msgtext As String
Dim mrc, mrc1, mrc2, mrc3 As ADODB.Recordset
Dim onnow, offnow As Integer
Dim intConsumetime, pay, pay1 As Single
If Not testtxt(Trim(txtcardno.Text)) Then
MsgBox “请输入卡号”, 0 + 48, “提示”
txtcardno.SetFocus
Exit Sub
End If
If Not IsNumeric(txtcardno.Text) Then
MsgBox “请输入数字”, 0 + 48, “提示”
txtcardno.Text = “”
txtcardno.SetFocus
Exit Sub
End If
txtsql = “select * from BasicData_Info”
Set mrc3 = ExecuteSQL(txtsql, msgtext)

        txtsql = "select * from online_info where cardno = '" & (Trim(txtcardno.Text)) & "'"
        Set mrc = ExecuteSQL(txtsql, msgtext)
        
        If mrc.EOF Then
            MsgBox "卡号没有上机", 0 + 48, "提示"
            txtcardno.Text = ""
            txtcardno.SetFocus
            Exit Sub
        Else
        
        txtsql = "select * from line_info where cardno = '" & (Trim(txtcardno.Text)) & "'"
        Set mrc1 = ExecuteSQL(txtsql, msgtext)
        
        intConsumetime = Trim(DateDiff("n", mrc.Fields(9), Now))            '把时间差转换为分钟
             If intConsumetime < mrc3.Fields(4) Then
                txtconsume.Text = 0
                txtcash.Text = mrc1!cash
                Call viewdata
                txtsql = "delete * from online_info where cardno = '" & (Trim(txtcardno.Text)) & "'"
                Set mrc = ExecuteSQL(txtsql, msgtext)
                MsgBox "下机成功", 0 + 48, "提示"
            Else
                If mrc.Fields(1) = "临时用户" Then
                        txtconsume.Text = (Int(intConsumetime / 60) + 1) * Trim(mrc3.Fields(1))
                        txtcash.Text = Trim(mrc1.Fields(7)) - Trim(txtconsume.Text)
                        txtsql = "delete * from online_info where cardno = '" & (Trim(txtcardno.Text)) & "'"
                        Set mrc = ExecuteSQL(txtsql, msgtext)
                        Call viewdata
                        MsgBox "下机成功", 0 + 48, "提示"
                 Else
           
                        txtcash.Text = Trim(mrc1.Fields(12)) - (Int(intConsumetime / 60) + 1) * Trim(mrc3.Fields(0))
                        txtsql = "delete * from online_info where cardno = '" & (Trim(txtcardno.Text)) & "'"
                        Set mrc = ExecuteSQL(txtsql, msgtext)
                        Call viewdata
                        MsgBox "下机成功", 0 + 48, "提示"
                        
                 End If
            End If
        End If
            
End Sub

• 上机代码

Private Sub Command1_Click()
Dim txtsql, msgtext As String
Dim mrc As ADODB.Recordset
Dim mrc1 As ADODB.Recordset
Dim mrc2 As ADODB.Recordset

Dim a As Object
Set a = CreateObject("Wscript.Network") '获取计算机名

   If Not testtxt(Trim(txtcardno.Text)) Then
        MsgBox "请输入卡号", 0 + 48, "提示"
        txtcardno.SetFocus
        txtcardno.Text = ""
        Exit Sub
    End If

    If Not IsNumeric(txtcardno.Text) Then
        MsgBox "请输入数字", 0 + 48, "提示"
        Exit Sub
    End If

    txtsql = "select * from student_info where cardno = '" & txtcardno.Text & "'"
    Set mrc1 = ExecuteSQL(txtsql, msgtext)

    If mrc1.EOF Then
         MsgBox "卡号不存在", 0 + 48, "提示"
         Exit Sub
    Else
            txtsql = "select * from online_info where cardno = '" & (Trim(txtcardno.Text)) & "'"
            Set mrc = ExecuteSQL(txtsql, msgtext)
        
            If mrc.EOF = False Then
                MsgBox "卡号以上机", 0 + 48, "提示"
                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 = Date
                txtontime.Text = Time
                  mrc1.Update
                 Exit Sub
            End If


        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 = Date
        txtontime.Text = Time
          mrc1.Update
          
         mrc.AddNew
        mrc.Fields(0) = Trim(txtcardno.Text)
        mrc.Fields(1) = mrc1!Type
        mrc.Fields(2) = mrc1!studentno
        mrc.Fields(3) = mrc1!studentname
        mrc.Fields(4) = mrc1!department
        mrc.Fields(5) = mrc1!sex
        mrc.Fields(6) = Date
        mrc.Fields(7) = Time
        mrc.Fields(8) = a.ComputerName  '获取计算机名
        mrc.Fields(9) = Now
         mrc.Update
         
    txtsql = "select * from line_info where cardno = '" & txtcardno.Text & "'"
    Set mrc2 = ExecuteSQL(txtsql, msgtext)

         mrc2.AddNew
        mrc2.Fields(1) = Trim(txtcardno.Text)
        mrc2.Fields(2) = mrc1!studentno
        mrc2.Fields(3) = mrc1!studentname
        mrc2.Fields(4) = mrc1!department
        mrc2.Fields(5) = mrc1!sex
        mrc2.Fields(6) = Date
        mrc2.Fields(7) = Time
        mrc2.Fields(11) = "0.0"
        mrc2.Fields(12) = mrc1!cash
        mrc2.Fields(14) = a.ComputerName
        mrc2.Fields(13) = "正常上机"
         mrc2.Update
     txtpeople.Text = mrc.RecordCount
    mrc.Close
    mrc1.Close
    mrc2.Close
    End If
     End Sub