机房收费系统-上下机

前言：

    机房收费系统当然离不开上机和下机了，作为整个系统的核心和关键，我觉得最重要的是首先要有全局观，把控整体的流程。还有就是一定要细心，考虑到所有应该注意到的问题。实现上下机的功能我基本上一天就敲出来了，但是之后却优化了一个星期，每天基本上都需要去改动去重新捋思路，所以说一开始一定要摸清楚表与表之间的关系，理清思路，再去敲，这样效率就会提高很多很多。好了，下面我来给大家介绍一下上下机到底如何实现，以及其中应该注意的小问题！

内容：

   1、理清思路：

    上机：

     

    下机：

  

   2、注意点：

   （1）、上机时间如果超过一天？通过datediff函数，将日期和时间都转换为分钟数。

time1 = Trim(DateDiff("n", Text10.Text, Time))                
time2 = Trim(DateDiff("n", Text7.Text, Date))

   

   （2）、如何考虑到准备时间和最少上机时间？若上机时间小于准备时间，则消费时间为0。若上机时间减去准备时间小于最少上机时间，则用一个固定的金额计算。其他则用上机时间减去准备时间则为消费时间。

If Val(time1) + Val(time2) < mrc1.Fields(3) Then                        '上机时间小于准备时间,则消费时间为0
         time3 = 0 & ""
Else
     If Val(time1) + Val(time2) - Val(mrc1.Fields(3)) < Val(mrc1.Fields(4)) Then
         time3 = 0.5 & ""
     Else
         time3 = Val(time1) + Val(time2) - Val(mrc1.Fields(3))          '否则则是上机时间减去准备时间
     End If
End If

  （3）、考虑固定用户和临时用户各自的费用。

  3、代码实现

上机：

Private Sub cmdOnline_Click()
    Text2.Text = ""
    Text3.Text = ""
    Text4.Text = ""
    Text5.Text = ""
    Text6.Text = ""
    Text7.Text = ""
    Text8.Text = ""
    Text9.Text = ""
    Text10.Text = ""
    Text11.Text = ""
    Text12.Text = ""
    Text13.Text = ""
  If Text1.Text = "" Then
    MsgBox "请输入要上机的卡号！", vbOKOnly + vbExclamation, "警告"
    Text1.SetFocus
  Else
    txtsql = "select * from online_Info where cardno= '" & Trim(Text1.Text) & "'"
    Set mrc = ExecuteSQL(txtsql, Msgtext)
    
    If mrc.EOF = False Then                                                '判断此卡号是否在上机
      MsgBox "此卡号正在上机！", vbOKOnly + vbExclamation, "警告"
      Text1.Text = ""
      Text2.Text = ""
      Text3.Text = ""
      Text4.Text = ""
      Text5.Text = ""
      Text6.Text = ""
      Text7.Text = ""
      Text8.Text = ""
      Text9.Text = ""
      Text10.Text = ""
      Text11.Text = ""
      Text12.Text = ""
      Text13.Text = ""
      Exit Sub
    Else
       txtsql = "select * from student_Info where cardno= '" & Trim(Text1.Text) & "'and status='" & "使用" & "'"
       Set mrc = ExecuteSQL(txtsql, Msgtext)
     
       If mrc.EOF = True Then
         MsgBox "此卡号不存在", vbOKOnly + vbExclamation, "警告"
         Text1.Text = ""
         Exit Sub
       Else
         If Val(mrc.Fields(7)) < 1 Then                                  '判断余额是否不能上机
           MsgBox "余额不足，请先充值！", vbOKOnly + vbExclamation, "警告"
           Text1.Text = ""
           Exit Sub
         Else
         Text2.Text = mrc.Fields(1)                       '更新上下机界面
         Text3.Text = mrc.Fields(4)
         Text4.Text = mrc.Fields(14)
         Text5.Text = mrc.Fields(2)
         Text6.Text = mrc.Fields(3)
         Text7.Text = Date
         Text10.Text = Time
         Text9.Text = Val(mrc.Fields(7))
         
         txtsql = "select * from OnLine_Info"        '增加状态为上机的表的数据
         Set mrc = ExecuteSQL(txtsql, Msgtext)
        
         mrc.AddNew
         mrc.Fields(0) = Trim(Text1.Text)
         mrc.Fields(1) = Trim(Text4.Text)
         mrc.Fields(2) = Trim(Text2.Text)
         mrc.Fields(3) = Trim(Text5.Text)
         mrc.Fields(4) = Trim(Text3.Text)
         mrc.Fields(5) = Trim(Text6.Text)
         mrc.Fields(6) = Trim(Text7.Text)
         mrc.Fields(7) = Trim(Text10.Text)
         mrc.Fields(8) = Trim("WEJ")
         mrc.Fields(9) = Date
         mrc.Update
         lblOnlineNumber.Caption = mrc.RecordCount                 '在界面上显示正在上机的人数
         mrc.Close
         
         txtsql = "select * from Line_Info"                     '增加上机记录
         Set mrc2 = ExecuteSQL(txtsql, Msgtext)
         mrc2.AddNew
         mrc2.Fields(1) = Trim(Text1.Text)
         mrc2.Fields(2) = Trim(Text2.Text)
         mrc2.Fields(3) = Trim(Text5.Text)
         mrc2.Fields(4) = Trim(Text3.Text)
         mrc2.Fields(5) = Trim(Text6.Text)
         mrc2.Fields(6) = Trim(Text7.Text)
         mrc2.Fields(7) = Trim(Text10.Text)
         mrc2.Fields(13) = "正常上机"
         mrc2.Fields(14) = "WEJ"
         mrc2.Update
      End If
    End If
  End If
 End If
End Sub

下机：

Private Sub cmdOffline_Click()
  Dim time1, time2, time3
  If Text1.Text = "" Then                                    '判断卡号是否为空
    MsgBox "请输入卡号！", vbOKOnly + vbExclamation, "警告"
  Else
    txtsql = "select * from OnLine_Info where cardno= '" & Trim(Text1.Text) & "'"
    Set mrc = ExecuteSQL(txtsql, Msgtext)
    
    If mrc.EOF = True Then                                  '判断此卡是否正在上机
      MsgBox "该卡号未上机，请重新确认", vbOKOnly + vbExclamation, "警告"
      Text1.Text = ""
      Text1.SetFocus
      Text2.Text = ""
      Text3.Text = ""
      Text4.Text = ""
      Text5.Text = ""
      Text6.Text = ""
      Text7.Text = ""
      Text8.Text = ""
      Text9.Text = ""
      Text10.Text = ""
      Text11.Text = ""
      Text12.Text = ""
      Text13.Text = ""
      Exit Sub
    Else
      Text2.Text = mrc.Fields(2)                                         '更新窗体上的信息
      Text3.Text = mrc.Fields(4)
      Text4.Text = mrc.Fields(1)
      Text5.Text = mrc.Fields(3)
      Text6.Text = mrc.Fields(5)
      Text7.Text = mrc.Fields(6)
      Text8.Text = Date
      Text10.Text = mrc.Fields(7)
      Text11.Text = Time
      time1 = Trim(DateDiff("n", Text10.Text, Time))                  '把时间差转换为分钟
      time2 = Trim(DateDiff("n", Text7.Text, Date))                   '把日期差转换为分钟
      
      txtsql = "select * from BasicData_Info"                    '从数据表中获取基本数据
      Set mrc1 = ExecuteSQL(txtsql, Msgtext)
      
      If Val(time1) + Val(time2) < mrc1.Fields(3) Then           '上机时间小于准备时间,则消费时间为0
         time3 = 0 & ""
      Else
         time3 = Val(time1) + Val(time2) - Val(mrc1.Fields(3))   '否则则是上机时间减去准备时间
      End If
      Text12.Text = Val(time3)                                   '更新消费时间
      
      
      If mrc.Fields(1) = "固定用户" Then
          Text13.Text = Int(mrc1.Fields(0) / 60 * Val(Text12.Text))     '计算固定用户金额
      Else                                                              '计算临时用户金额
          Text13.Text = Int(mrc1.Fields(1) / 60 * Val(Text12.Text))
          mrc1.Close
      End If
        
      
      
     txtsql = "select * from student_Info where cardno= '" & Trim(Text1.Text) & "'and status='" & "使用" & "'"       '得出余额
     Set mrc3 = ExecuteSQL(txtsql, Msgtext)
     Text9.Text = Val(Trim(mrc3.Fields(7)) - Val(Text13.Text))
     mrc3.Fields(7) = Val(Text9.Text)
     mrc3.Update
     mrc3.Close
              
     txtsql = "select * from Line_Info where cardno= '" & Trim(Text1.Text) & "'and ondate='" & Trim(Text7.Text) & "'and ontime='" & Trim(Text10.Text) & "'"                       '增加上机记录
     Set mrc6 = ExecuteSQL(txtsql, Msgtext)
     If Not mrc6.EOF Then
       mrc6.Fields(8) = Trim(Text8.Text)
       mrc6.Fields(9) = Trim(Text11.Text)
       mrc6.Fields(10) = Trim(Text12.Text)
       mrc6.Fields(11) = Val(Text13.Text)
       mrc6.Fields(12) = Trim(Text9.Text)
       mrc6.Fields(13) = "正常下机"
       mrc6.Update
       mrc6.Close
     End If
     
    mrc.Delete
    mrc.Update
    mrc.Close
    txtsql = "select * from OnLine_Info"
    Set mrc4 = ExecuteSQL(txtsql, Msgtext)
    lblOnlineNumber.Caption = mrc4.RecordCount
    mrc4.Close
  End If
 End If
End Sub

总结：

      一次一次优化之后，其实上下机真得没有大家想象中的那么难。还是最重要的一句话，理清思路，真的贯穿整个机房收费系统的起末！