机房收费之上下机

         机房开始已经有段时间了，今天来整理一下上下机部分的思路，对这部分的学习做一个小结。在我们想实现一个功能时首先我们需要了解其逻辑结构，无论多复杂的功能都是由简单的0和1构成的，只要我们理清各判断语句的逻辑结构，通过语句调用各数据表信息，实现简单的数据查询和管理的功能就变得很容易了。

    上机逻辑结构图：。

    

     下机逻辑结构图：

  

     在了解整体的结构后就是编写代码了，每个人都自己的特点，写代码也是如此。不必局限于别人的思维，可以按照自己的习惯来写代码，但是一定要注意逻辑结构，有时候虽然代码没有问题但是逻辑上错误也是无法实现目标功能。

     上机代码：

    Private Sub cmdon_Click()
   Dim mrc As ADODB.Recordset
   Dim txtSQL As String
   Dim MsgText As String
   Dim mrc1 As ADODB.Recordset
   Dim txtsql1 As String
   Dim mrc2 As ADODB.Recordset
   Dim txtsql2 As String
   Dim mrc3 As ADODB.Recordset
   Dim txtsql3 As String
  
  If Not Testtxt(txtcardno.Text) Then
     MsgBox "请您填写您的账号信息", vbOKOnly + vbExclamation, "警告"    '判断输入是否为空
     txtcardno.SetFocus
   Exit Sub
  End If
   txtSQL = "select * from student_Info where cardno='" & Trim(txtcardno.Text) & "'and status='" & "使用" & "'"
     Set mrc = ExecuteSQL(txtSQL, MsgText)
    If mrc.EOF Then
      MsgBox "该账号不存在", vbOKOnly + vbExclamation, "警告"       '判断是否存在该账号
      txtcardno = ""
      txtcardno.SetFocus
   Else
      txtsql2 = "select * from OnLine_Info where cardno='" & Trim(txtcardno.Text) & "'"
        Set mrc2 = ExecuteSQL(txtsql2, MsgText)
        If mrc2.EOF = False Then
         MsgBox "该账号正在上机", vbOKOnly + vbExclamation, "警告"   '判断是否正在上机状态
         txtcardno = ""
          txtcardno.SetFocus
    Else
       
       txtsql3 = "select * from BasicData_Info"
       Set mrc3 = ExecuteSQL(txtsql3, MsgText)
        If Val(mrc.Fields(7)) < Val(mrc3.Fields(5)) Then   '此处代表余额小于设定的最小的上机金额，
        '如果只是小于一个具体数字的话会导致最低金额改动时，此处的约束无效
        MsgBox "余额不足，请先充值", vbOKOnly + vbExclamation, "提示"
        txtcardno = ""
        
      Else
      
        txtstudentno.Text = mrc.Fields(1)     '文本框获得student_info的数据
        txtdepartment.Text = mrc.Fields(4)
        txttype.Text = mrc.Fields(14)
        txtname.Text = mrc.Fields(2)
        txtsex.Text = mrc.Fields(3)
        txtontime.Text = Time
        txtondate.Text = Date
        txtcash.Text = mrc.Fields(7)
        
        mrc2.AddNew
        mrc2.Fields(0) = txtcardno.Text    '将正在上机的用户数据导入online_info中
        mrc2.Fields(1) = txttype.Text
        mrc2.Fields(2) = txtstudentno.Text
        mrc2.Fields(3) = txtname.Text
        mrc2.Fields(4) = txtdepartment.Text
        mrc2.Fields(5) = txtsex.Text
        mrc2.Fields(6) = txtondate.Text
        mrc2.Fields(7) = txtontime.Text
        mrc2.Fields(8) = VBA.Environ("computername") '显示计算机名称
        mrc2.Fields(9) = Now
        mrc2.Update
        labelnumber.Caption = "当前上机人数：" & mrc2.RecordCount
        mrc2.Close
        
        txtsql1 = "select * from Line_Info"
        Set mrc1 = ExecuteSQL(txtsql1, MsgText)
        
        mrc1.AddNew
        mrc1.Fields(1) = txtcardno.Text     '用户的资料导入line_中 即上机记录表中
        mrc1.Fields(2) = txtstudentno.Text
        mrc1.Fields(3) = txtname.Text
        mrc1.Fields(4) = txtdepartment.Text
        mrc1.Fields(5) = txtsex.Text
        mrc1.Fields(6) = txtondate.Text
        mrc1.Fields(7) = txtontime.Text
        mrc1.Fields(13) = "正常上机"
        mrc1.Fields(14) = VBA.Environ("computername")
        mrc1.Update
        mrc1.Close
        
        MsgBox "上机成功", vbOKOnly + vbExclamation, "警告"
        txtcardno.Text = ""
        txtcardno.SetFocus
        End If
     End If
   End If
     
End Sub

    

        下机代码：     

Private Sub cmdoff_Click()
  Dim mrc As ADODB.Recordset
  Dim txtSQL As String
  Dim MsgText As String
  
  Dim mrc1 As ADODB.Recordset
  Dim txtsql1 As String
  Dim MsgText1 As String
  
  Dim mrc2 As ADODB.Recordset
  Dim txtsql2 As String
  Dim msgtext2 As String
  
  Dim mrc3 As ADODB.Recordset
  Dim txtsql3 As String
  Dim msgtext3 As String
  
  Dim contime As Single
  Dim consume As Single
  
  If Not Testtxt(txtcardno.Text) Then
     MsgBox "请填写您的账号信息", vbOKOnly + vbExclamation, "警告"    '判断输入是否为空
     txtcardno.SetFocus
   Exit Sub
  End If
  
txtSQL = "select * from student_Info where cardno='" & Trim(txtcardno.Text) & "'and status='" & "使用" & "'"
 Set mrc = ExecuteSQL(txtSQL, MsgText)
  If mrc.EOF Then
    MsgBox "该卡号尚未注册", vbOKOnly + vbExclamation, "警告"     '判断是否存在账号信息
    txtcardno.SetFocus
    txtcardno.Text = ""
   
   Else
    txtsql1 = "select * from OnLine_Info where cardno='" & Trim(txtcardno.Text) & "'"
    Set mrc1 = ExecuteSQL(txtsql1, MsgText1)                    '判断是否正在上机
     If mrc1.EOF Then
      MsgBox "此卡号并未上机，请检查您的卡号", vbOKOnly + vbExclamation, "警告"
      txtcardno.Text = ""
      txtcardno.SetFocus                     '若正在上机调用online的表中
      Exit Sub '针对记录为空在此添加结束
     Else
        txtstudentno.Text = mrc1.Fields(2)     '文本框获得online_info的数据
        txtdepartment.Text = mrc1.Fields(4)
        txttype.Text = mrc1.Fields(1)
        txtname.Text = mrc1.Fields(3)
        txtsex.Text = mrc1.Fields(5)
        txtontime.Text = mrc1.Fields(7)
        txtondate.Text = mrc1.Fields(6)
        txtofftime.Text = Time
        txtoffdate.Text = Date
        labelnumber.Caption = "当前上机人数：" & mrc1.RecordCount - 1
        
     contime = DateDiff("n", mrc1.Fields(9), Format(Now(), "yyyy-mm-dd hh:mm:ss"))
     txtcontime.Text = Val(contime)     '通过使用DateDiff函数对上机时间进行计算，并在此转化为分钟
     
     txtsql2 = "select * from BasicData_Info"
     Set mrc2 = ExecuteSQL(txtsql2, msgtext2)
     
     If contime < mrc2.Fields(4) Then   '上机时间小于准备时间，不计算金额
      consume = 0
       
        Else
        
        txtSQL = "select * from student_Info where cardno='" & (txtcardno.Text) & "'"
         Set mrc = ExecuteSQL(txtSQL, MsgText)  '消费金额=消费时间*单位费用（不同用户类型分别计算）
                                                '利用Round函数进行四舍五入取整
          If mrc.Fields(14) = "固定用户" Then
          consume = Round(((contime - mrc2.Fields(4)) / 60) * mrc2.Fields(0), 0)
           
           Else
            consume = Round(((contime - mrc2.Fields(4)) / 60) * mrc2.Fields(1), 0)
            End If
            
            txtconsume.Text = Int(consume)
            End If
            
            Dim yue As Integer
            yue = Val(mrc.Fields(7) - consume)   '卡号余额=账户余额-消费额度
            txtcash.Text = yue
            
            mrc.Fields(7) = txtcash.Text
            mrc.Update
            mrc.Close
            mrc2.Close
        End If
          
          
          txtsql3 = "select * from Line_Info where cardno='" & Trim(txtcardno.Text) & "'"
          Set mrc3 = ExecuteSQL(txtsql3, msgtext3)
           
          mrc3.Fields(8) = txtoffdate.Text    '完善整个上机记录即line_info
          mrc3.Fields(9) = txtofftime.Text
          mrc3.Fields(10) = txtcontime.Text
          mrc3.Fields(11) = consume       '针对类型不匹配，直接将函数值赋到表中
          mrc3.Fields(12) = txtcash.Text
          mrc3.Fields(13) = "正常下机"
          mrc3.Update
          mrc3.Close
          
          MsgBox "下机成功", vbOKOnly + vbExclamation, "警告"
          txtcardno = ""
          txtcardno.SetFocus
          
          mrc1.Delete
           
          End If
 
End Sub     

     纸上得来终觉浅，绝知此事要躬行。只有理论与实践相结合才能让我们的学习更有效率，对知识的理解也更加的透彻。虽然这次仅仅是个开头，不过通过自己的尝试大大增强自信心，相信自己肯定能够做好这个项目的，加油！！！