【第一次机房】机房收费系统——上机

上机是机房收费系统中非常重要的一个功能，也是最先需要实现的功能呢，以上是上机的流程图

  

   

    

     

    
    

     

      Private Sub cmdOnLine_Click()
     
    
   

    

     

    
    

     
    Dim startime As String
     
    
   

    

     

    
    

     
    Dim mrc As ADODB.Recordset     '连接student表中的
     
    
   

    

     

    
    

     
    Dim txtSQL As String
     
    
   

    

     

    
    

     
    Dim MsgText As String
     
    
   

    

     

    
    

     
    Dim mrc1 As ADODB.Recordset  '连接online表中的
     
    
   

    

     

    
    

     
    Dim mrc2 As ADODB.Recordset  '连接line表中的
     
    
   

    

     

    
    

     
    
     
    
   

    

     

    
    

     
    '检查卡号是否存在
     
    
   

    

     

    
    

     

          txtSQL = "select * from student_Info where cardno= '" & txtCardNo.Text & "'"
     
    
   

    

     

    
    

     
    Set mrc = ExecuteSQL(txtSQL, MsgText)
     
    
   

    

     

    
    

     
    
     
    
   

    

     

    
    

     
    If mrc.EOF Then
     
    
   

    

     

    
    

     

              MsgBox "没有这个卡号，请重新输入！", vbOKOnly + vbExclamation, "警告"
     
    
   

    

     

    
    

     

              txtCardNo.Text = ""
     
    
   

    

     

    
    

     

              mrc.Close
     
    
   

    

     

    
    

     

              txtCardNo.SetFocus
     
    
   

    

     

    
    

     
    Else
     
    
   

    

     

    
    

     
        If Trim(mrc.Fields(10)) = "不使用" Then
     
    
   

    

     

    
    

     

                  MsgBox "没有此卡号"
     
    
   

    

     

    
    

     
        Else
     
    
   

    

     

    
    

     
            If Trim(Val(mrc.Fields(7))) <= 0 Then
     
    
   

    

     

    
    

     

                  MsgBox "余额不足，请充值"
     
    
   

    

     

    
    

     

                  txtCardNo.Text = ""
     
    
   

    

     

    
    

     

                       txtName.Text = ""
     
    
   

    

     

    
    

     

                       txtSex.Text = ""
     
    
   

    

     

    
    

     

                       txtSID.Text = ""
     
    
   

    

     

    
    

     

                       txtDept.Text = ""
     
    
   

    

     

    
    

     

                       txtType.Text = ""
     
    
   

    

     

    
    

     

                       txtOffDate.Text = ""
     
    
   

    

     

    
    

     

                       txtOnTime.Text = ""
     
    
   

    

     

    
    

     

                       txtOnDate.Text = ""
     
    
   

    

     

    
    

     

                       txtOffTime.Text = ""
     
    
   

    

     

    
    

     

                       txtCTime.Text = ""
     
    
   

    

     

    
    

     

                       txtCMoney.Text = ""
     
    
   

    

     

    
    

     
            Else
     
    
   

    

     

    
    

     
            
     
    
   

    

     

    
    

     
                '点击上机，下机时间和日期，消费时间和金额文本框中数据清空
     
    
   

    

     

    
    

     

                      txtOnDate.Text = ""
     
    
   

    

     

    
    

     

                      txtOnTime.Text = ""
     
    
   

    

     

    
    

     

                      txtCTime.Text = ""
     
    
   

    

     

    
    

     

                      txtCMoney.Text = ""
     
    
   

    

     

    
    

     
                
     
    
   

    

     

    
    

     
                '检查上机是否重复
     
    
   

    

     

    
    

     

                      txtSQL = "select * from Online_Info where cardno = '" & txtCardNo.Text & "'"
     
    
   

    

     

    
    

     
                Set mrc1 = ExecuteSQL(txtSQL, MsgText)
     
    
   

    

     

    
    

     
                
     
    
   

    

     

    
    

     
                If mrc1.EOF Then
     
    
   

    

     

    
    

     
                    '从student表中向各个文本框中添加上机的数据
     
    
   

    

     

    
    

     
                    
     
    
   

    

     

    
    

     

                          mrc.Update
     
    
   

    

     

    
    

     

                              txtSID.Text = mrc.Fields(1)
     
    
   

    

     

    
    

     

                              txtName.Text = mrc.Fields(2)
     
    
   

    

     

    
    

     

                              txtSex.Text = mrc.Fields(3)
     
    
   

    

     

    
    

     

                              txtDept.Text = mrc.Fields(4)
     
    
   

    

     

    
    

     

                              txtBalance.Text = mrc.Fields(7)
     
    
   

    

     

    
    

     

                              txtType.Text = mrc.Fields(14)
     
    
   

    

     

    
    

     
                    
     
    
   

    

     

    
    

     

                          mrc.Close
     
    
   

    

     

    
    

     
                    
     
    
   

    

     

    
    

     
                    '如果没有查到数据，那么创建一个新行，添加各个数据
     
    
   

    

     

    
    

     

                          mrc1.AddNew
     
    
   

    

     

    
    

     

                              mrc1.Fields(0) = Trim(txtCardNo.Text)
     
    
   

    

     

    
    

     

                              mrc1.Fields(1) = Trim(txtType.Text)
     
    
   

    

     

    
    

     

                              mrc1.Fields(2) = Trim(txtSID.Text)
     
    
   

    

     

    
    

     

                              mrc1.Fields(3) = Trim(txtName.Text)
     
    
   

    

     

    
    

     

                              mrc1.Fields(4) = Trim(txtDept.Text)
     
    
   

    

     

    
    

     

                              mrc1.Fields(5) = Trim(txtSex.Text)
     
    
   

    

     

    
    

     

                              mrc1.Fields(6) = Date
     
    
   

    

     

    
    

     

                              mrc1.Fields(7) = Time
     
    
   

    

     

    
    

     

                              mrc1.Fields(8) = VBA.Environ("computername")
     
    
   

    

     

    
    

     
                        
     
    
   

    

     

    
    

     

                          startime = Now  '获得系统时间
     
    
   

    

     

    
    

     

                          txtOnDate.Text = Format(startime, "yyyy/mm/dd")
     
    
   

    

     

    
    

     

                          txtOnTime.Text = Format(startime, "hh:mm:ss") '使用格式函数显示格式
     
    
   

    

     

    
    

     

                          mrc1.Update
     
    
   

    

     

    
    

     
                    
     
    
   

    

     

    
    

     
                    '刷新line表中的数据
     
    
   

    

     

    
    

     

                          txtSQL = "select * from Line_Info where cardno = '" & txtCardNo.Text & "'"
     
    
   

    

     

    
    

     
                    Set mrc2 = ExecuteSQL(txtSQL, MsgText)
     
    
   

    

     

    
    

     
                    
     
    
   

    

     

    
    

     

                          mrc2.AddNew
     
    
   

    

     

    
    

     

                          mrc2.Fields(1) = Trim(txtCardNo.Text)
     
    
   

    

     

    
    

     

                          mrc2.Fields(13) = "正常下机"
     
    
   

    

     

    
    

     
                    
     
    
   

    

     

    
    

     

                          mrc2.Fields(2) = Trim(txtSID.Text)
     
    
   

    

     

    
    

     

                          mrc2.Fields(3) = Trim(txtName.Text)
     
    
   

    

     

    
    

     

                          mrc2.Fields(4) = Trim(txtDept.Text)
     
    
   

    

     

    
    

     

                          mrc2.Fields(5) = Trim(txtSex.Text)
     
    
   

    

     

    
    

     

                          mrc2.Fields(6) = Date
     
    
   

    

     

    
    

     

                          mrc2.Fields(7) = Time
     
    
   

    

     

    
    

     

                          mrc2.Fields(14) = VBA.Environ("computername")
     
    
   

    

     

    
    

     
                    
     
    
   

    

     

    
    

     

                          mrc2.Update
     
    
   

    

     

    
    

     
                    
     
    
   

    

     

    
    

     

                          MsgBox "上机成功", vbOKOnly + vbExclamation, "登录成功"
     
    
   

    

     

    
    

     
                Else
     
    
   

    

     

    
    

     

                          MsgBox "此用户正在上机"
     
    
   

    

     

    
    

     
                End If
     
    
   

    

     

    
    

     
            End If
     
    
   

    

     

    
    

     
        End If
     
    
   

    

     

    
    

     
    End If
     
    
   

    

     

    
    

     

      End Sub
     
    
  
 

以上是代码部分，供大家参考

文章来源: blog.csdn.net，作者：翟文彪，版权归原作者所有，如需转载，请联系作者。

原文链接：blog.csdn.net/zwb568/article/details/104065698