【机房收费系统】问题集锦

太过爱你忘了你带给我的痛 2022-08-04 10:42 152阅读 0赞

敲机房的时候感觉有一些的问题需要改进所以就相应的做了一些的更改

1、当卡号中余额为0的时候自动下机

Dim mrc As ADODB.Recordset              '选择在线online表
       Dim txtSQl, MsgText As String
       Dim mr As ADODB.Recordset               '选择学生表提取金额
       Dim m As ADODB.Recordset                '选择基本数据表用于固定用户和临时用户开销
       Dim mrr As ADODB.Recordset
    
       txtSQl = "select * from online_info"
       Set mrc = ExecuteSQL(txtSQl, MsgText)
    
       txtSQl = "select * from BasicData_Info"
       Set m = ExecuteSQL(txtSQl, MsgText)
    
       Do While Not mrc.EOF
          txtSQl = "select * from student_Info where cardno='" & Trim(mrc.Fields(0)) & "'"
          Set mr = ExecuteSQL(txtSQl, MsgText)
    
         mrc.Fields(10) = Trim(mrc.Fields(10)) + 1
          mrc.Update
    
          If Trim(mr.Fields(14)) = "固定用户" Then
            txtTime.Text = mr.Fields(7) / m.Fields(1) * 60 - mrc.Fields(10)
            alltime.Text = mr.Fields(7) / m.Fields(1) * 60
          Else
            txtTime.Text = mr.Fields(7) / m.Fields(0) * 60 - mrc.Fields(10)
            alltime.Text = mr.Fields(7) / m.Fields(0) * 60
          End If
           txtadd.Text = DateDiff("n", mrc.Fields(6), Format(Now, "yyyy-mm-dd")) '计算相差分钟数
           txtadd.Text = txtadd.Text + DateDiff("n", Trim(mrc.Fields(7)), Format(Now, "hh:mm:ss"))
           If Int(txtadd.Text) > Int(alltime) Then
              MsgBox ("卡号" & mrc.Fields(0) & "已经没有费了"), vbOKOnly + vbExclamation, "提示"
              mr.Fields(7) = 0
              mr.Fields(6) = "不使用"
              mr.Update
            End If
          If txtTime.Text < 10 And txtTime.Text > 8 Then
              MsgBox ("卡号" & Trim(mrc.Fields(0)) & "余额不足，十分钟后将自动下机，请尽快提示充值")
          End If
          If txtTime.Text = 1 Then
              MsgBox ("卡号" & Trim(mrc.Fields(0)) & "即将在1分钟后自动下机")
          End If
          If txtTime.Text = 0 Then
              MsgBox ("卡号" & Trim(mrc.Fields(0)) & "余额为0，欢迎下次再来")
              mr.Fields(10) = "不使用"
              mr.Update
            End If
         If Trim(mr.Fields(6)) = "不使用" Then
              txtSQl = "delete from online_info where cardno='" & mr.Fields(10) & "'"
              Set mrr = ExecuteSQL(txtSQl, MsgText)
          End If
          mrc.MoveNext
       Loop

2、对于上机来说是比较容易的但是下机是最难搞定的 （需要想很多的东西）

首先就是卡号是否为空、卡号要是数字、卡号是否还在使用、此卡是否正在上机

再次计时计算时间，根据消费的时间算出相应的花销

最后就是更新Line\_info 中的数据库  删除Online\_info中下机的卡号的信息

<span style="font-size:18px;">Dim mrc As ADODB.Recordset
    Dim mrcc As ADODB.Recordset
    Dim mrcd As ADODB.Recordset
    Dim mrce As ADODB.Recordset
    Dim txtSQl As String
    Dim MsgText As String
    Dim Usetime, UnitNumber, a, b, c As String
        '判断下机卡号是否为空
        If txtCardID.Text = "" Then                          '判断卡号是否为空
            MsgBox "请输入卡号！", 0 + 48, "提示"
            Exit Sub
            txtCardID.SetFocus
            txtCardID.Text = ""
        End If
        '判断下机卡号是否是数字
        If Not IsNumeric(txtCardID.Text) Then                 '判断卡号是否为数字
            MsgBox "卡号请输入数字！", 0 + 48, "提示"
            txtCardID.SetFocus
            txtCardID.Text = ""
            Exit Sub
        End If
        '判断卡号是否还在使用
        txtSQl = "select * from student_Info where cardno ='" & Trim(txtCardID.Text) & "'"
        Set mrcd = ExecuteSQL(txtSQl, MsgText)
        If mrcd.EOF Then
            MsgBox "卡号不存在或者已经不用了", 0 + 48, "提示"                                   '判断卡号是否被使用
            Exit Sub
        End If
        '判断输入的卡号是否在上机
        txtSQl = "select * from OnLine_Info where cardno = '" & Trim(txtCardID.Text) & "'"
        Set mrce = ExecuteSQL(txtSQl, MsgText)
        If mrce.EOF Then
            MsgBox "此卡号没有上机，请重新选择！", vbOKOnly + vbExclamation, "警告"
            txtID.Text = ""
            txtDepartment.Text = ""
            txtType.Text = ""
            txtName.Text = ""
            txtSex.Text = ""
            txtOndate.Text = ""
            txtOntime.Text = ""
            txtCash.Text = ""
            txtOffdate.Text = ""
            txtOfftime.Text = ""
            txtCosttime.Text = ""
            txtCost.Text = ""
            txtCardID.Text = ""
            Exit Sub
        Else
        '此卡正在上机
            txtID.Text = mrcd.Fields(1)
            txtDepartment.Text = mrcd.Fields(4)
            txtType.Text = mrcd.Fields(14)
            txtName.Text = mrcd.Fields(2)
            txtSex.Text = mrcd.Fields(3)
            txtOndate.Text = mrce.Fields(6)
            txtOntime.Text = mrce.Fields(7)
            c = mrce.Fields(7)
            txtOntime.Text = c
            mrce.Delete
            Label4.Caption = mrce.RecordCount
        End If
    
    
         txtOffdate.Text = Format(Date, "yyyy-mm-dd")
         txtOfftime.Text = Format(time, "hh:mm")
         b = Abs(DateDiff("n", txtOfftime, c))                         '计算上机时间
            txtCosttime.Text = b
    
        '计算上机时间
        txtSQl = "select * from BasicData_Info"
        Set mrc = ExecuteSQL(txtSQl, MsgText)
        '第一种情况:上机时间<准备时间
        If Val(txtCosttime.Text) < Val(mrc.Fields(4)) Then                '上机时间小于准备时间
            txtCost.Text = 0
            txtCosttime.Text = 0
    
        '第二种情况:准备时间<上机时间<最下上机时间
        ElseIf Val(mrc.Fields(4)) <= Val(txtCosttime.Text) And Val(txtCosttime.Text) <= Val(mrc.Fields(3)) Then    '准备时间<上机时间<最少上机时间
            txtCost.Text = 1
            txtCash.Text = Val(mrcd.Fields(7)) - 1
            mrcd.Fields(7) = Trim(txtCash.Text)
            mrcd.Update
    
        '第二种情况:上机时间>最小上机时间
        ElseIf Val(txtCosttime.Text) > Val(mrc.Fields(3)) Then           '上机时间>最小上机时间
            Usetime = Val(txtCosttime.Text) - Val(mrc.Fields(4))
            UnitNumber = Usetime Mod Val(mrc.Fields(2))
                If UnitNumber = 0 Then                                   '用时小于周期
                    UnitNumber = Int(Usetime / Val(mrc.Fields(2)))       'int是取整函数，取证原则是比括号中的数值小的最接近的整数，不进行四舍五入。 所以 比-2.9还小的整数是-3，同样分析知道，int(2.9)=2
                Else                                                     '用时大于周期  如  90/60=1.5  int(1.5)=1   说以要+1
                    UnitNumber = Int(Usetime / Val(mrc.Fields(2))) + 1
                End If
        End If
        '判断此时用户类别
        If mrcd.Fields(14) = "固定用户" Then
            a = Val(mrc.Fields(0))
        Else
            a = Val(mrc.Fields(1))
        End If
        '计算最后的花销
        txtCost.Text = Format(UnitNumber * a, "0.0")                      '计算最后的花费
        txtCash.Text = Val(mrcd.Fields(7)) - Val(txtCost.Text)
        mrcd.Fields(7) = Trim(txtCash.Text)
        mrcd.Update
    
        txtSQl = "select * from Line_Info " '‘where '正常上机' and cardno ='" & Trim(txtCardID.Text) & "'"
        Set mrcc = ExecuteSQL(txtSQl, MsgText)
        mrcc.AddNew
        mrcc.Fields(1) = Trim(txtCardID.Text)
        mrcc.Fields(2) = Trim(txtID.Text)
        mrcc.Fields(3) = Trim(txtName.Text)
        mrcc.Fields(4) = Trim(txtDepartment.Text)
        mrcc.Fields(5) = Trim(txtSex.Text)
        mrcc.Fields(6) = txtOndate.Text
        mrcc.Fields(7) = txtOntime.Text
        mrcc.Fields(14) = Trim(VBA.Environ("computername"))      '获取计算机名
        mrcc.Fields(11) = Trim(txtCost.Text)
        mrcc.Fields(12) = Trim(txtCash.Text)
          mrcc.Fields(8) = Trim(txtOffdate.Text)
            mrcc.Fields(9) = Trim(txtOfftime.Text)
            mrcc.Fields(10) = Trim(txtCosttime.Text)
            mrcc.Fields(13) = Trim("正常下机")
        mrcc.Update</span>

3、关于报表

'日结账单刷新
    Dim txtSQl As String
      Dim mrc As ADODB.Recordset
      Dim MsgText As String
      
      GRDisplayViewer1.Stop
      txtSQl = "select * from CheckDay_info"
          '创建报表对象
     Set Report = New grproLibCtl.GridppReport
            '载入报表模版文件
        Report.LoadFromFile (App.Path & "\daycheck.grf")
         '设置数据连接串
        Report.DetailGrid.Recordset.ConnectionString = ConnectString
        Report.DetailGrid.Recordset.QuerySQL = txtSQl
            '显示报表中的内容
      ' GRDisplayViewer1.Refresh  '刷新
       GRDisplayViewer1.Report = Report
       GRDisplayViewer1.Start
       
    '   给报表赋值
        Report.ParameterByName("EndDate").Value = Format(Now, "yyyy-mm-dd")
       Report.ParameterByName("XX").Value = Trim(Username)
       Report.ParameterByName("OPT").Value = Trim(Username)

最后机房已经完成的差不多了，就更新到这里吧！机房给我的教训就是以后再做一个系统之前一定要先理清思路。