机房收费系统之上下机

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

上机时：首先，判断上机卡号是否为已经注册的卡号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 String
Dim txtSQL2 As String
Dim txtSQL3 As String
Dim txtSQL4 As String
Dim Msgtext As String
Dim MsgText2 As String
Dim MsgText3 As String
Dim MsgText4 As String

Dim mrc As ADODB.Recordset
Dim Object As ADODB.Recordset
Dim Object2 As ADODB.Recordset
Dim Object3 As ADODB.Recordset

Dim ondate As Date
Dim ontime As Date
Dim txtdate As Single
Dim txttime As Single
Dim Outdate As Date
Dim Outtime As Date
Dim Style As String
Dim inttime As Single
Dim Balance As Single
Dim basicPay As Single
Dim 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 "卡号不存在，请重新输入或重新注册！","警告"
        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 "该卡号没有在上机，不能进行下机处理","警告"
            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 If
End Sub

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

Private Sub cmdup_Click()
Dim mrc As ADODB.Recordset
Dim txtSQL As String
Dim Msgtext As String
Dim cash As Double
Dim Object As ADODB.Recordset
Dim txtSQL2 As String
Dim MsgText2 As String


    txtSQL2 = "select * from BasicData_Info"
    Set Object = ExecuteSQL(txtSQL2,MsgText2)

    If Not Testtxt(Trim(txtcard.Text)) Then
        MsgBox "请输入准备上机的卡号","警告"                   '判断要上机的卡号是否为空
        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 "该卡号没有注册请重新输入",警告"
        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 "卡内余额不足请充值后登陆","警告"
                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 "此卡正在上机","警告"        '该卡正在上机，给出提示
        End If
        
    End If
End Sub

Private Sub Panduan()
Dim txtSQL2 As String
Dim MsgText2 As String
Dim txtSQL4 As String
Dim MsgText4 As String
Dim Object As ADODB.Recordset
Dim 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 Sub
End Sub

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!