第一次机房收费系统-回顾总结（二）

整个程序的中心功能最复杂的设计都在于这个MDI的窗体中。

整个窗体虽然只有简单的两个按钮，需要完成的任务却是不少。
首先来看看有趣的 上机按钮 如下：

Private Sub cmdUP_Click(Index As Integer)
   Dim txtsql, MsgText As String
   Dim mrc As ADODB.Recordset     '定义数据库的连接

   '任务一: 根据卡号查找信息 并插入到OnLine

   '判断是否未输入卡号
   If Trim(cdn.Text = "") Then
      MsgBox "请先输入卡号！", vbOKOnly + vbExclamation, "警告"
      cdn.SetFocus
   Else
   '在数据库中查询卡号信息
      txtsql = "select * from student_Info where cardno = '" & cdn.Text & "'"
      Set mrc = ExecuteSQL(txtsql, MsgText)

      If mrc.EOF Then
         MsgBox "未找到信息，请检查输入卡号是否正确！", vbOKOnly + vbExclamation, "警告"
         cdn.SetFocus
      Else

      '判断该卡是否正在上机使用中
      txtsql = "select * from OnLine_Info where cardno = '" & cdn.Text & "'"
      Set mrc = ExecuteSQL(txtsql, MsgText)

      If mrc.EOF = False Then
         MsgBox "该卡已在使用中，无法登录！", vbOKOnly + vbExclamation, "警告"
         cdn.SetFocus
      Else

      '查询卡号信息将信息返回到主界面
      txtsql = "select * from student_Info where cardno = '" & cdn.Text & "'"
      Set mrc = ExecuteSQL(txtsql, MsgText)
            sno.Text = Trim(mrc.fields(1))   
            snm.Text = Trim(mrc.fields(2))
            sex.Text = Trim(mrc.fields(3))
            dpt.Text = Trim(mrc.fields(4))
            cah.Text = Trim(mrc.fields(7))
            zhuceDate = Trim(mrc.fields(12))
            typ.Text = Trim(mrc.fields(14))
            ddt.Text = " 上机中 "
            dtm.Text = " 上机中 "
            ctm.Text = " 上机中 "
            cch.Text = " 上机中 "

     '为确保数据的安全准确，将从服务器获取准确时间（具体函数是在模块中定义）       
            Call SQL_Timer
            udt.Text = Left(Stime, 9)
            utm.Text = Right(Stime, 8)
            Date = Left(Stime, 9)
            Time = Right(Stime, 8)

      '添加信息到online数据表
      txtsql = "select * from OnLine_Info"
      Set mrc = ExecuteSQL(txtsql, MsgText)

      mrc.AddNew
      mrc.fields(0) = cdn.Text
      mrc.fields(1) = typ.Text
      mrc.fields(2) = sno.Text
      mrc.fields(3) = snm.Text
      mrc.fields(4) = dpt.Text
      mrc.fields(5) = sex.Text
      mrc.fields(6) = udt.Text
      mrc.fields(7) = utm.Text
      mrc.fields(8) = Left(Environ("computername"), 5)
      mrc.fields(9) = Date
      mrc.Update

      '再次查询上机人数并跟新到主界面
      Label14.Caption = "当前上机人数为：" & mrc.RecordCount & " 人"

      MsgBox "本卡上机成功！", vbOKOnly + vbInformation, "提示"

      mrc.Close

      End If
    End If
  End If

End Sub

再来说说最精彩的 下机按钮 如下：

Private Sub cmdDW_Click(Index As Integer)
   Dim txtsql As String
   Dim mrc As ADODB.Recordset
   Dim MsgText As String


'任务一:删除online表中的信息，添加信息到line表



   '判断卡号是否为空
   If Trim(cdn.Text = "") Then
      MsgBox "请先输入卡号！", vbOKOnly + vbExclamation, "警告"
      cdn.SetFocus
   Else
   '判断卡号是否在上机
      txtsql = "select * from online_Info where cardno = '" & cdn.Text & "'"
      Set mrc = ExecuteSQL(txtsql, MsgText)

      If mrc.EOF Then
         MsgBox "该卡号未在上机！", vbOKOnly + vbExclamation, "警告"
         cdn.SetFocus
      Else
   '    
       typ.Text = mrc.fields(1)   '刷新到当前卡号的信息到主界面
       sno.Text = mrc.fields(2)
       snm.Text = mrc.fields(3)
       dpt.Text = mrc.fields(4)
       sex.Text = mrc.fields(5)
       udt.Text = mrc.fields(6)
       utm.Text = mrc.fields(7)



      Call SQL_Timer           '读取服务器时间
      mrc.fields(8) = Left(Stime, 9)
      mrc.fields(9) = Right(Stime, 8)

      Date = DateValue(Stime)  '修改电脑时间为服务器时间



    '查询BaseDate数据表，获得设定的基本数据
    BasicDataSQL = "select * from BasicData_Info "
    Set mrcBasicData = ExecuteSQL(BasicDataSQL, BMsgtext)

    '任务二：计算出用户消费

    '实际在线时间
    intLineTime = Date * 1440 - DateValue(udt.Text) * 1440 + Hour(Time) * 60 - Hour(TimeValue(utm.Text)) * 60 + Minute(Time) - Minute(TimeValue(utm.Text))

    '把固定用户、临时用户30分钟的费用分别赋值
    ctm.Text = intLineTime

     fixedRate = Val(mrcBasicData.fields(0))     
     fixedRate1 = Val(mrcBasicData.fields(1))     

     '判断时间是否小于准备时间-小于则消费时间为0     

     If intLineTime <= Val(Trim(mrcBasicData.fields(4))) Then
        cch.Text = 0
     Else
        '判断在线时间是否小于最低消费时间-小于消费为0
        If intLineTime <= Val(Trim(mrcBasicData.fields(3))) Then
            cch.Text = 0

       Else
         '根据用户类型，赋值单位消费金额
         If intLineTime >= Val(Trim(mrcBasicData.fields(3))) And intLineTime < Val(Trim(mrcBasicData.fields(2))) And Trim(typ.Text) = "固定用户" Then
            cch.Text = fixedRate
        Else
            If intLineTime >= Val(Trim(mrcBasicData.fields(3))) And intLineTime < Val(Trim(mrcBasicData.fields(2))) And Trim(typ.Text) = "临时用户" Then
               cch.Text = fixedRate1
            Else  
       '在线时间大于单位时间-按个单位时间计费
                If intLineTime > Val(Trim(mrcBasicData.fields(3))) And Trim(typ.Text) = "固定用户" Then
                   curConsume = intLineTime / Val(Trim(mrcBasicData.fields(2)))
                   cch.Text = Val(curConsume) * Val(fixedRate)
                Else

                       curConsume = intLineTime / Val(Trim(mrcBasicData.fields(2)))
                       cch.Text = Val(curConsume) * Val(fixedRate1)

                End If
            End If
        End If
    End If
End If

    '计算用户余额（账户余额=原账户余额-消费金额）
     txtsql = "select * from student_Info"
     Set mrc = ExecuteSQL(txtsql, MsgText)
     curBalance = mrc.fields(7) - Val(cch.Text)
     mrc.fields(7) = curBalance
     mrc.Update
 '添加信息到上机记录表
      txtsql = "select * from Line_Info"
      Set mrc = ExecuteSQL(txtsql, MsgText)
      mrc.AddNew

      mrc.fields(1) = cdn.Text
      mrc.fields(2) = sno.Text
      mrc.fields(3) = snm.Text
      mrc.fields(4) = dpt.Text
      mrc.fields(5) = sex.Text
      mrc.fields(6) = udt.Text
      mrc.fields(7) = utm.Text

      Call SQL_Timer                  '从服务器获取标准时间
      mrc.fields(8) = Left(Stime, 9)
      mrc.fields(9) = Right(Stime, 8)

      mrc.fields(10) = curConsume
      mrc.fields(11) = cch.Text
      mrc.fields(12) = curBalance
      mrc.fields(13) = "正常下机"
      mrc.fields(14) = "PC"
      mrc.Update


      ddt.Text = mrc.fields(8)
      dtm.Text = mrc.fields(9)
      cah.Text = mrc.fields(12)

 '删除用户的上机状态信息     
      txtsql = "select * from online_Info where cardno = '" & cdn.Text & "'"
      Set mrc = ExecuteSQL(txtsql, MsgText)
      mrc.Delete
      mrc.Update
 '更新在线人数     
      txtsql = "select * from OnLine_Info "
      Set mrc = ExecuteSQL(txtsql, MsgText)
      Label14.Caption = "当前上机人数为：" & mrc.RecordCount & " 人"



End Sub

虽有程序作为参照，但是所有代码均为作者敲出，若有错漏，好的建议 期待您的分享~
感谢您的阅读！