【机房收费系统】机房收费系统之上下机

       在敲机房管理系统的一段时间内，感觉最难的就是上下机问题。这里运用了大量的计算。下面是我的源代码展示：

     

上机时：首先，判断上机卡号是否为已经注册的卡号Studnet_Info表。然后，判断该卡是否正在上机Online_Info表。在判断余额是否大于上机最低金额BasicData_Info表。

下机时：首先输入下机卡号。Studnet_Info表中判断该卡号是否存在，如果不存在提示注册。如果存在，判断Online_Info中是否正在上机，如果正在上机将此记录删除。然后在Line_Info表中填入数据。如果没有上机则提示没有上机信息，上机则进行数值计算和显示。最后更新Studnet_Info表中的cash余额，用总的减去消费的。

下机代码：

</pre><pre name="code" class="vb">private Sub cmddown_Click()Dim txtSQL As StringDim txtSQL2 As StringDim txtSQL3 As StringDim txtSQL4 As StringDim Msgtext As StringDim MsgText2 As StringDim MsgText3 As StringDim MsgText4 As StringDim mrc As ADODB.RecordsetDim Object As ADODB.RecordsetDim Object2 As ADODB.RecordsetDim Object3 As ADODB.RecordsetDim ondate As DateDim ontime As DateDim txtdate As SingleDim txttime As SingleDim Outdate As DateDim Outtime As DateDim Style As StringDim inttime As SingleDim Balance As SingleDim basicPay As SingleDim returnCash As Single    If Not Testtxt(txtcard.Text) Then        MsgBox "请输入下机卡号", vbOKOnly + vbExclamation, "警告"        Exit Sub    End If    txtSQL = "select * from student_Info where cardno = '" & txtcard.Text & "' "    Set mrc = ExecuteSQL(txtSQL, Msgtext)     '判断卡号是否存在    If mrc.BOF And mrc.EOF Then                                                  '如果不存在则给出提示        MsgBox "卡号不存在，请重新输入或重新注册！", vbOKOnly + vbExclamation, "警告"        txtcard.SetFocus        Exit Sub    Else                                                                         '如果存在，则判断是否正在上机        Balance = Trim(mrc.Fields(7))        txtSQL2 = "select * from Online_Info where cardno = '" & txtcard.Text & "' "        Set Object = ExecuteSQL(txtSQL2, MsgText2)        If Object.BOF And Object.EOF Then                                         '卡号没有上机，则给出提示            MsgBox "该卡号没有在上机，不能进行下机处理", vbOKOnly + vbExclamation, "警告"            txtcard.SetFocus            Exit Sub        Else            '上机时间计算            txtShangdate.Text = Trim(Object.Fields(6))       'ondate上机日期            txtShangTime.Text = Trim(Object.Fields(7))       'ontime上机时间            txtStudentNO.Text = Trim(Object.Fields(2))       'StudentNo学号            txtUserName.Text = Trim(Object.Fields(3))        '姓名            txtXiBie.Text = Trim(Object.Fields(4))           '系别            txtsex.Text = Trim(Object.Fields(5))             '性别            txtOuttime.Text = Format(Time, "hh:mm:ss")       '下机时间            txtOutdate.Text = Format(Date, "yyyy-mm-dd")     '下机日期            txtBalance.Text = Balance                        '余额            Outdate = Format(txtOutdate.Text, "yyyy-mm-dd")            Outtime = Format(txtOuttime.Text, "hh:mm:ss")            ondate = Format(Trim(Object.Fields(6)), "yyyy-mm-dd")            ontime = Format(Trim(Object.Fields(7)), "hh:mm:ss")            txtdate = DateDiff("n", ondate, Outdate)            txttime = DateDiff("n", ontime, Outtime)       'DateDiff求时间差值            txtConsumeMin.Text = Int(txttime) + Int(txtdate)            inttime = txtConsumeMin.Text            Style = Trim(Object.Fields(1))            txtstyle.Text = Style                   '类型            '上机金额计算            txtSQL3 = "select * from BasicData_Info "            Set Object2 = ExecuteSQL(txtSQL3, MsgText3)                        If Style = "固定用户" Then             '判断用户类型                basicPay = Val(Trim(Object2.Fields(0)))                '判断上机时间是否超过准备时间                If inttime < Val(Object2.Fields(4)) Then                    txtConsumeMin.Text = 0                    txtConsumeMoney.Text = 0                    returnCash = Val(Trim(txtBalance.Text) - Trim(txtConsumeMoney.Text))                    txtBalance.Text = returnCash                    mrc.Fields(7) = txtBalance.Text                    mrc.Update                    Call Panduan                Else           '判断上机时间是否超过最短时间                        txtConsumeMin.Text = inttime                                 '在窗体上显示上网时间                    If inttime <= Val(Object2.Fields(3)) Then                       '没超过最短时间按最短时间收费                        txtConsumeMoney.Text = basicPay                        returnCash = Trim(txtBalance.Text) - Trim(txtConsumeMoney.Text)                        txtBalance.Text = returnCash                        mrc.Fields(7) = txtBalance.Text                        mrc.Update                        Call Panduan                    Else            '超过最短时间，判断消耗的时间是否正好是要求时间的倍数，判断是不是有超出不满足要求时间的部分，这部分仍然按照要求时间收费                        If Val(inttime) Mod 30 = 0 Then                               '消耗时间，正好等于要求的单位时间                            txtConsumeMoney.Text = Val(inttime) \ 30 * basicPay \ 2                            returnCash = Trim(txtBalance.Text) - Trim(txtConsumeMoney.Text)                            txtBalance.Text = returnCash                            mrc.Fields(7) = txtBalance.Text          '更新student_Info表中的cash余额                             mrc.Update                            Call Panduan                        Else                            txtConsumeMoney.Text = (Val(inttime) \ 30 + 1) * basicPay \ 2                            returnCash = Val(Trim(txtBalance.Text) - Trim(txtConsumeMoney.Text))                            txtBalance.Text = returnCash                            mrc.Fields(7) = txtBalance.Text          '更新student_Info表中的cash余额                            mrc.Update                            Call Panduan                        End If                    End If                End If            Else               '临时用户的消费计算方式                basicPay = Val(Trim(Object2.Fields(1)))                If inttime < Val(Object2.Fields(4)) Then                    txtConsumeMin.Text = 0                    txtConsumeMoney.Text = 0                    returnCash = Trim(txtBalance.Text) - Trim(txtConsumeMoney.Text)                    txtBalance.Text = returnCash                    mrc.Fields(7) = txtBalance.Text                 '更新student_Info表中的cash余额                    mrc.Update                    Call Panduan                Else                    txtConsumeMin.Text = inttime                    If inttime <= Val(Object2.Fields(3)) Then                        txtConsumeMoney.Text = basicPay                        returnCash = Trim(txtBalance.Text) - Trim(txtConsumeMoney.Text)                        txtBalance.Text = returnCash                        mrc.Fields(7) = txtBalance.Text             '更新student_Info表中cash余额                        mrc.Update                        Call Panduan                    Else                        If Val(inttime) Mod 30 = 0 Then                            txtConsumeMoney.Text = Val(inttime) \ 30 * basicPay \ 2                            returnCash = Trim(txtBalance.Text) - Trim(txtConsumeMoney.Text)                            txtBalance.Text = returnCash                            mrc.Fields(7) = txtBalance.Text         '更新student_Info表中的cash余额                            mrc.Update                            Call Panduan                        Else                            txtConsumeMoney.Text = (Val(inttime) \ 30 + 1) * basicPay \ 2                            returnCash = Trim(txtBalance.Text) - Trim(txtConsumeMoney.Text)                            txtBalance.Text = returnCash                            mrc.Fields(7) = txtBalance.Text           '更新到student_Info表中的cash余额                            mrc.Update                            Call Panduan                        End If                    End If                End If            End If        End If    End IfEnd Sub

上机代码：

<span style="font-family: Arial, Helvetica, sans-serif;"></span>

Private Sub cmdup_Click()Dim mrc As ADODB.RecordsetDim txtSQL As StringDim Msgtext As StringDim cash As DoubleDim Object As ADODB.RecordsetDim txtSQL2 As StringDim MsgText2 As String    txtSQL2 = "select * from BasicData_Info"    Set Object = ExecuteSQL(txtSQL2, MsgText2)    If Not Testtxt(Trim(txtcard.Text)) Then        MsgBox "请输入准备上机的卡号", vbOKOnly + vbExclamation, "警告"                   '判断要上机的卡号是否为空        Exit Sub    End If        txtSQL = "select * from student_Info where cardno = '" & txtcard.Text & "' "    Set mrc = ExecuteSQL(txtSQL, Msgtext)    '判断student_Info表中是否存在该卡号    If mrc.BOF And mrc.EOF Then                                                                         '如果不存在        MsgBox "该卡号没有注册请重新输入", vbOKOnly + vbExclamation, 警告"        txtcard.Text = ""        txtcard.SetFocus    Else        cash = Trim(mrc.Fields(7))                                                         '获取上机卡号的余额        txtSQL = "select * from Online_Info where cardno = '" & txtcard.Text & "' "        '判断该卡号是否正在上机        Set mrc = ExecuteSQL(txtSQL, Msgtext)        If mrc.EOF Then            If cash < Trim(Object.Fields(5)) Then                                                                '判断余额是否足够                MsgBox "卡内余额不足请充值后登陆", vbOKOnly + vbExclamation, "警告"                txtcard.Text = ""                Exit Sub            Else                txtSQL = "select * from student_Info where cardno = '" & txtcard.Text & "' "   '没有上机，去student_info表中查找相关数据记录              <span style="white-space:pre"></span>Set mrc = ExecuteSQL(txtSQL, Msgtext)                txtstyle.Text = Trim(mrc.Fields(14))                txtStudentNO.Text = Trim(mrc.Fields(1))                txtUserName.Text = Trim(mrc.Fields(2))                txtXiBie.Text = Trim(mrc.Fields(4))                txtsex.Text = Trim(mrc.Fields(3))                txtBalance.Text = Trim(mrc.Fields(7))                ad = Trim(mrc.Fields(9))                txtSQL = "insert into Online_Info values('" & txtcard.Text & "', '" & txtstyle.Text & "','" & txtStudentNO.Text & "','" & txtUserName.Text & "','" & txtXiBie.Text & "','" & txtsex.Text & "','" & Date & "','" & Time & "','" & Trim(Winsock1.LocalHostName) & "','" & Now & "','" & ad & "')"                Set mrc = ExecuteSQL(txtSQL, Msgtext)                '添加到Online_Info 表中                Labelsjtime.Visible = True                txtShangdate.Text = Date                txtShangTime.Text = Time            End If        Else            MsgBox "此卡正在上机", vbOKOnly + vbExclamation, "警告"        '该卡正在上机，给出提示        End If            End IfEnd Sub

在Line_Info表中填入数

Private Sub Panduan()Dim txtSQL2 As StringDim MsgText2 As StringDim txtSQL4 As StringDim MsgText4 As StringDim Object As ADODB.RecordsetDim Object3 As ADODB.Recordset    txtSQL2 = "delete Online_Info where cardno = '" & txtcard.Text & "' "    Set Object = ExecuteSQL(txtSQL2, MsgText2)    txtSQL4 = "select * from Line_Info"    Set Object3 = ExecuteSQL(txtSQL4, MsgText4)    Object3.AddNew    Object3.Fields(1) = txtcard.Text    Object3.Fields(2) = txtStudentNO.Text    Object3.Fields(3) = txtUserName.Text    Object3.Fields(4) = txtXiBie.Text    Object3.Fields(5) = txtsex.Text    Object3.Fields(6) = txtShangdate.Text    Object3.Fields(7) = txtShangTime.Text    Object3.Fields(8) = txtOutdate.Text    Object3.Fields(9) = txtOuttime.Text    Object3.Fields(10) = txtConsumeMin.Text    Object3.Fields(11) = txtConsumeMoney.Text    Object3.Fields(12) = txtBalance.Text    Object3.Fields(13) = "正常下机"    Object3.Fields(14) = Trim(Winsock1.LocalHostName)    Object3.Fields(15) = "未结账"    Object3.Fields(16) = ad    Object3.Update    Object3.Close        MsgBox "下机成功，欢迎再次光临！", vbOKOnly + vbInformation, "欢迎再次光临"    Exit SubEnd Sub