机房收费系统---上、下机

前言：

       今天无意之中不小心点了一下，竟然出来的是机房收费系统。然后又仔细一想，自己的机房收费系统都没怎么好好总结过，只是单纯的把项目过了，然而想着总结，结果拖延症犯了，越拖越久，然后就忘记这么一回事了。

内容：

上机：

（1）上机思路：

 

 Dim txtSQL As String
    Dim mrc As ADODB.Recordset   'mrc是一个字符串数组,student表。
    Dim MsgText As String
    Dim mrc1 As ADODB.Recordset    'BasicData表
    Dim mrc2 As ADODB.Recordset    'Online表
    Dim mrc3 As ADODB.Recordset    'line表

    If Trim(txtCardNo.Text) = "" Then
         MsgBox "请输入卡号!", vbOKOnly + vbExclamation, "警告"
         txtCardNo.SetFocus
         Exit Sub
    Else
    
    If Not IsNumeric(Trim(txtCardNo)) Then
      MsgBox "请输入数字!", vbOKOnly + vbExclamation, "警告"
      txtCardNo.SetFocus
      txtCardNo.Text = ""
      Exit Sub
    Else
    
     txtSQL = "select * from student_Info where cardno = '" & Trim(txtCardNo.Text) & "'"
     Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF = True Then
        MsgBox "卡号不存在或未被注册！", vbOKOnly + vbExclamation, "警告"
        txtCardNo.SetFocus
        txtCardNo.Text = ""
        Exit Sub
    Else
      txtSQL = "select * from BasicData_Info "
      Set mrc1 = ExecuteSQL(txtSQL, MsgText)
      If Val(mrc.Fields(7)) < Val(mrc1.Fields(5)) Then
         MsgBox "余额只有" & mrc.Fields(7) & ",少于最低金额，请先充值！", vbOKOnly + vbExclamation, "警告"
        Exit Sub
    Else
   
      txtSQL = "select * from Online_Info where cardno = '" & Trim(txtCardNo.Text) & "'"
      Set mrc2 = ExecuteSQL(txtSQL, MsgText)
        
    If mrc2.EOF = False And mrc2.BOF = False Then
      MsgBox "此卡正在上机，不能重复上机！!", vbOKOnly + vbExclamation, "警告"
      txtCardNo.SetFocus
      
      Exit Sub
    Else
    
    lblType.Text = Trim(mrc.Fields(14))
    lblSID.Text = Trim(mrc.Fields(1))
    lblName.Text = Trim(mrc.Fields(2))
    lblDept.Text = Trim(mrc.Fields(4))
    lblSex.Text = Trim(mrc.Fields(3))
    lblOnDate.Text = Date
    lblOnTime.Text = Time
    
    '将上机前的余额，提取出来，用于下机的计算
    lblBaLance.Text = Trim(mrc.Fields(7))
    
    txtSQL = "select * from OnLine_Info "
    Set mrc2 = ExecuteSQL(txtSQL, MsgText)
    
    mrc2.AddNew
    mrc2.Fields(0) = Trim(txtCardNo.Text)
    mrc2.Fields(1) = Trim(lblType.Text)
    mrc2.Fields(2) = Trim(lblSID.Text)
    mrc2.Fields(3) = Trim(lblName.Text)
    mrc2.Fields(4) = Trim(lblDept.Text)
    mrc2.Fields(5) = Trim(lblSex.Text)
    mrc2.Fields(6) = Date
    mrc2.Fields(7) = Time
    mrc2.Fields(8) = Environ("USERNAME")
    mrc2.Fields(9) = Date + Time
    mrc2.Update
    mrc2.Close
    
    '将上机记录写进line表
    txtSQL = "select * from Line_Info "
    Set mrc3 = ExecuteSQL(txtSQL, MsgText)
    
    mrc3.AddNew
    mrc3.Fields(1) = Trim(txtCardNo.Text)
    mrc3.Fields(2) = Trim(lblSID.Text)
    mrc3.Fields(3) = Trim(lblName.Text)
    mrc3.Fields(4) = Trim(lblDept.Text)
    mrc3.Fields(5) = Trim(lblSex.Text)
    mrc3.Fields(6) = Date
    mrc3.Fields(7) = Time
'    mrc3.Fields(8) = ""
'    mrc3.Fields(9) = ""
'    mrc3.Fields(10) = ""
    
    mrc3.Fields(11) = "0.0"
    mrc3.Fields(12) = Trim(lblBaLance.Text)
    mrc3.Fields(13) = "正常上机"
    mrc3.Fields(14) = Environ("USERNAME")      '获取电脑名字
    
    mrc3.Update
    mrc3.Close
    
    
    
    End If
   End If
  End If
 End If
End If

（2）获取上机人数：

Private Sub Timer1_Timer()
Text1 = Time$   '返回自 Unix 纪元（January 1 1970 00:00:00 GMT）起的当前时间的秒数的函数。
Dim txtSQL As String
Dim MsgText As String
Dim mrc2 As ADODB.Recordset
txtSQL = "select * from Online_Info "
 Set mrc2 = ExecuteSQL(txtSQL, MsgText)


Label16.Caption = mrc2.RecordCount
mrc2.Close
End Sub

下机：

下机思路：

其中涉及到临时用户和固定用户，需要仔细考虑清楚。

代码展示：

Private Sub cmdOffLine_Click()
      Dim txtSQL As String
      Dim mrc As ADODB.Recordset   'mrc是一个字符串数组,student表。
      Dim MsgText As String
      Dim mrc1 As ADODB.Recordset    'BasicData表
      Dim mrc2 As ADODB.Recordset    'Online表
      Dim mrc3 As ADODB.Recordset     'line表
      Dim Unitcash As Single
      Dim UnitNumber As Integer
  
  If Trim(txtCardNo.Text) = "" Then
         MsgBox "请输入卡号!", vbOKOnly + vbExclamation, "警告"
         txtCardNo.SetFocus
         Exit Sub
  Else
    
  If Not IsNumeric(Trim(txtCardNo)) Then
        MsgBox "请输入数字!", vbOKOnly + vbExclamation, "警告"
        txtCardNo.SetFocus
        txtCardNo.Text = ""
        Exit Sub
  Else
  
        txtSQL = "select * from student_Info where cardno = '" & Trim(txtCardNo.Text) & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
  If mrc.EOF = True Then            '判断此卡是否注册,使用
        MsgBox "卡号不存在或未被注册！", vbOKOnly + vbExclamation, "警告"
        txtCardNo.SetFocus
        txtCardNo.Text = ""
        Exit Sub
  Else
  
        txtSQL = "select * from Online_Info where cardno = '" & Trim(txtCardNo.Text) & "'"
        Set mrc2 = ExecuteSQL(txtSQL, MsgText)
        
  If mrc2.EOF = True Then           '判断此卡是否上机
        MsgBox "此卡没有上机或者已下机！", vbOKOnly + vbExclamation, "警告"
        txtCardNo.SetFocus
        txtCardNo.Text = ""
        Exit Sub
  Else
        
        lblType.Text = Trim(mrc.Fields(14))
        lblSID.Text = Trim(mrc.Fields(1))
        lblName.Text = Trim(mrc.Fields(2))
        lblDept.Text = Trim(mrc.Fields(4))
        lblSex.Text = Trim(mrc.Fields(3))
        lblOnDate.Text = Trim(mrc.Fields(6))
        lblOnTime.Text = Trim(mrc.Fields(7))
        
        lblOffDate.Text = Date
        lblOffTime.Text = Time
         
       
       ' lblCTime.Text = Abs(Val(DateDiff("n", Time, Trim(lblOnTime.Text)))) '计算消费时间
       
        lblCTime.Text = Date * 1440 - DateValue(mrc2!ondate) * 1440 + Hour(Time) * 60 - Hour(TimeValue(mrc2!OnTime)) * 60 + Minute(Time) - Minute(TimeValue(mrc2!OnTime))
        '连接基本表
        txtSQL = "select * from BasicData_Info "
        Set mrc1 = ExecuteSQL(txtSQL, MsgText)
   '第一种情况，判断是否大于准备时间
  If Val(lblCTime.Text) <= Val(mrc1.Fields(4)) Then   '小于准备时间，金额为0
        lblCMoney.Text = 0

  End If
    '第二种情况，判断消费时间是否大于最少上机时间
  If Val(lblCTime.Text) <= Val(mrc1.Fields(3)) Then  '小于最少时间，消费金额为1元
        lblCMoney.Text = 1

  Else
  'Unitcash = Format((Val(mrc1.Fields(2)) / 30) * Unittime, "0.0")
    '第三种情况：消费时间大于最少时间，分为固定用户和临时用户
   ' lblCTime.Text = Val(lblCTime.Text) - Val(mrc1.Fields(4))  '实际消费时间
    UnitNumber = Val(lblCTime.Text) Mod Val(mrc1.Fields(2))    '个数
    
  If UnitNumber = 0 Then
        UnitNumber = Int(Trim(lblCTime.Text) / mrc1!Unittime)
        
  Else
        UnitNumber = Trim(Int(Trim(lblCTime.Text) / mrc1!Unittime) + 1)
  End If
      ' Usecash = Format(UnitNumber * Unitcash, "0.0")
    
  If Val(lblCTime.Text) >= Val(mrc1.Fields(3)) And Trim(mrc.Fields(14)) = "固定用户" Then
  
      lblCMoney.Text = Format(UnitNumber * Val(mrc1.Fields(0)), "0.0")
     
  Else
  
  If Val(lblCTime.Text) >= Val(mrc1.Fields(3)) And Trim(mrc.Fields(14)) = "临时用户" Then
  
      lblCMoney.Text = Format(UnitNumber * Val(mrc1.Fields(1)), "0.0")
      
        
        
        
        
        
  End If
 End If
 End If
 End If
 End If
 End If
 End If
 
 
 
 
 
     txtSQL = "select * from student_Info where cardno = '" & Trim(txtCardNo.Text) & "'"
     Set mrc = ExecuteSQL(txtSQL, MsgText)
        
        
      '计算消费金额得到余额
        
     lblBaLance.Text = Val(mrc.Fields(7)) - Val(Trim(lblCMoney.Text))
     
    lblType.Text = Trim(mrc2.Fields(1))
    lblSID.Text = Trim(mrc2.Fields(2))
    lblName.Text = Trim(mrc2.Fields(3))
    lblDept.Text = Trim(mrc2.Fields(4))
    lblSex.Text = Trim(mrc2.Fields(5))
    lblOnDate.Text = Trim(mrc2.Fields(6))
    lblOnTime.Text = Trim(mrc2.Fields(7))
     
     
     
     
   
     
     mrc.Fields(7) = Trim(lblBaLance.Text)
     
     MsgBox "下机成功"
    
    txtSQL = "select * from Line_Info where cardno = '" & Trim(txtCardNo.Text) & "'"
    Set mrc3 = ExecuteSQL(txtSQL, MsgText)

     mrc3.Fields(8) = Date
     mrc3.Fields(9) = Time
     mrc3.Fields(10) = Trim(lblCTime.Text)
     mrc3.Fields(11) = Trim(lblCMoney.Text)
     mrc3.Fields(12) = Trim(lblBaLance.Text)
     mrc3.Fields(13) = "正常下机"
     mrc3.Fields(14) = Environ("USERNAME")
     mrc3.Update
     mrc3.Close
     
     mrc.Update
     mrc.Close

     mrc1.Close
     mrc2.Delete
     mrc2.Update
     mrc2.Close
     
     
    
     
End Sub

总结：

         博客还有许多需要完善的地方，以后慢慢改善。