机房收费之上下机

    刚开始敲上下机时觉得还比较难，主要还是没有缕清思路，没有明白自己要干嘛，所以就会有些盲目，通过下面这个流程图可以很清晰地知道自己每一步要怎么做，写代码的时候就简单了许多，上下机重要的部分还是和所花费的

钱算清楚了。

Private Sub shangji_Click()

Dim txtsql As String, txtSQL1 As String, txtSQL3 As StringDim Msgtext As StringDim mrc As ADODB.RecordsetDim rst As ADODB.RecordsetDim mrcc As ADODB.Recordset    If txtcardno(0).Text = "" Then    '判断卡号是否为空        MsgBox "卡号不能为空", vbOKOnly + vbExclamation, "提示"        txtcardno(0).SetFocus        Exit Sub    Else        txtsql = "select * from student_info where cardno ='" & Trim(txtcardno(0).Text) & "'"        Set mrc = ExecuteSQL(txtsql, Msgtext)        txtSQL1 = "SELECT * from basicdata_info"        Set rst = ExecuteSQL(txtSQL1, Msgtext)        If mrc.EOF And mrc.BOF Then         '判断卡号是否注册            MsgBox "此卡号尚未注册！", vbOKOnly + vbExclamation, "提示"            txtcardno(0).SelStart = 0   '返回或设置选择文本的起始位置            txtcardno(0).SelLength = Len(txtcardno(0).Text)    '选中的长度            txtcardno(0).SetFocus            Exit Sub        Else             If Trim(mrc.Fields(10)) = "不使用" Then                             MsgBox "此卡已退，不能使用！", vbOKOnly + vbExclamation, "提示"                txtcardno(0).SelStart = 0   '返回或设置选择文本的起始位置                txtcardno(0).SelLength = Len(txtcardno(0).Text)    '选中的长度                txtcardno(0).SetFocus                Exit Sub             Else                  If mrc.Fields(7) < rst.Fields(5) Then                  '判断余额是否充足                    MsgBox "余额只有" & mrc.Fields(7) & ",少于最少金额，请先充值！", vbOKOnly, "警告!"                    Exit Sub                  Else                  txtSQL3 = "select * from online_info where cardno='" & Trim(txtcardno(0).Text) & "'"                  Set mrcc = ExecuteSQL(txtSQL3, Msgtext)                                         If Not (mrcc.EOF And mrcc.BOF) Then                           '判断此卡号是否正在上机                           MsgBox "此卡号正在上机", vbOKOnly, "提示"                           txtID(1).Text = mrc.Fields(1)                           txtdepartment(2).Text = mrc.Fields(4)                           txttype(3).Text = mrc.Fields(14)                           txtName(4).Text = mrc.Fields(2)                           txtsex(5).Text = mrc.Fields(3)                           txtsdate(0).Text = mrcc.Fields(6)                           StartDate = txtsdate(0).Text                           txtamount(2).Text = mrc.Fields(7)                           txtstime(3).Text = mrcc.Fields(7)                           StartTime = txtstime(3).Text                           txtxdate(1).Text = ""                           txtxtime(4).Text = ""                           txtconsumetime(5).Text = ""                           txtconsumepay(6).Text = ""                                                     txtcardno(0).SelStart = 0   '返回或设置选择文本的起始位置                           txtcardno(0).SelLength = Len(txtcardno(0).Text)    '选中的长度                           txtcardno(0).SetFocus                           Exit Sub                        Else                            '显示卡号的相关信息                            txtID(1).Text = mrc.Fields(1)                            txtdepartment(2).Text = mrc.Fields(4)                            txttype(3).Text = mrc.Fields(14)                            txtName(4).Text = mrc.Fields(2)                            txtsex(5).Text = mrc.Fields(3)                            StartDate = Date                            txtsdate(0).Text = StartDate                            txtamount(2).Text = mrc.Fields(7)                            StartTime = Time                            txtstime(3).Text = StartTime                            txtxdate(1).Text = ""                            txtxtime(4).Text = ""                            txtconsumetime(5).Text = ""                            txtconsumepay(6).Text = ""                            Label1.Caption = "上机成功"                            '把信息录入到 online_info表中                            mrcc.AddNew                            mrcc.Fields(0) = txtcardno(0).Text                            mrcc.Fields(1) = txttype(3).Text                            mrcc.Fields(2) = txtID(1).Text                            mrcc.Fields(3) = txtName(4).Text                            mrcc.Fields(4) = txtdepartment(2).Text                            mrcc.Fields(5) = txtsex(5).Text                            mrcc.Fields(6) = txtsdate(0).Text                            mrcc.Fields(7) = txtstime(3).Text                            mrcc.Fields(8) = VBA.Environ("computername")                            mrcc.Fields(9) = Now                            mrcc.Update        '更新数据库                            mrcc.Close                        End If                   End If             End If         End If    End If     End Sub

</pre><pre name="code" class="vb">Private Sub xiaji_Click()Dim CostDate As Long, CostTime As Long, cash As LongDim alltime As Single                '上机时间Dim consumemoney As Currency    '上机费用Dim Rate, tmpRate, unittime, leasttime, preparetimeDim txtsql As String, txtSQL1 As String, txtSQL2 As String, txtSQL3 As StringDim Msgtext As StringDim mrc As ADODB.RecordsetDim rst As ADODB.RecordsetDim mrcc As ADODB.RecordsetDim line As ADODB.Recordset    txtSQL1 = "select * from online_info where cardno='" & Trim(txtcardno(0).Text) & "'"    Set mrc = ExecuteSQL(txtSQL1, Msgtext)                     '从数据库中选择卡号等于输入的卡号    txtSQL2 = "select * from student_info"    Set mrcc = ExecuteSQL(txtSQL2, Msgtext)           If mrc.EOF And mrc.BOF Then    '判断卡号是否在上机        MsgBox "此卡号没有上机！", vbOKOnly, "提示"     '如果没有在上机，提示        '信息为空        txtID(1).Text = ""                                '学号为空        txtdepartment(2).Text = ""        txttype(3).Text = ""        txtname(4).Text = ""        txtsex(5).Text = ""        txtsdate(0).Text = ""        txtamount(2).Text = ""        txtstime(3).Text = ""        txtxdate(1).Text = ""        txtxtime(4).Text = ""        txtconsumetime(5).Text = ""        txtconsumepay(6).Text = ""        txtcardno(0).SetFocus    Else        '显示一些信息        '下机日期和时间        EndDate = Date        EndTime = Time        '显示此卡号上机时的信息        txtID(1).Text = mrc.Fields(2)        txtdepartment(2).Text = mrc.Fields(4)        txttype(3).Text = mrc.Fields(1)        txtname(4).Text = mrc.Fields(3)        txtsex(5).Text = mrc.Fields(5)        StartDate = mrc.Fields(6)        txtsdate(0).Text = StartDate        txtamount(2).Text = mrcc.Fields(7)        StartTime = mrc.Fields(7)        txtstime(3).Text = StartTime               '计算消费时间        CostDate = DateDiff("n", StartDate, EndDate) '日期差返回分钟数        CostTime = DateDiff("n", StartTime, EndTime)    '时间差返回分钟数        alltime = CostDate + CostTime '使用时间为多少分钟                txtsql = "select * from basicdata_info"        Set rst = ExecuteSQL(txtsql, Msgtext)                '把数据库的值赋给各个字段        Rate = rst.Fields(0)        tmpRate = rst.Fields(1)        unittime = rst.Fields(2)        leasttime = rst.Fields(3)        preparetime = rst.Fields(4)               '收费情况        If alltime <= preparetime Then           consumemoney = 0        Else            If alltime <= leasttime Then               consumemoney = Val(Rate / 2)            Else                If txttype(3).Text = "固定用户" And alltime <= unittime Then                   consumemoney = Val(Rate)                                   ElseIf txttype(3).Text = "固定用户" And alltime > unittime Then                    consumemoney = Val(Rate * Int(alltime / 60 + 1))                                ElseIf txttype(3).Text = "临时用户" And alltime <= unittime Then                    consumemoney = Val(tmpRate)                ElseIf txttype(3).Text = "临时用户" And alltime < unittime Then                    consumemoney = Val(tmpRate * Int(alltime / 60 + 1))               End If            End If        End If        txtxdate(1).Text = EndDate        txtxtime(4).Text = EndTime        txtconsumetime(5).Text = alltime        txtconsumepay(6).Text = consumemoney        cash = txtamount(2).Text - consumemoney        txtamount(2).Text = cash  '更新金额        '数据库student_info中金额也更新              mrcc.Fields(7) = txtamount(2).Text        mrcc.Update        mrcc.Close        '删除online_info中记录        mrc.Delete        mrc.Update        '往line_info中添加记录        txtSQL3 = "select * from line_info"        Set line = ExecuteSQL(txtSQL3, Msgtext)        line.AddNew        line.Fields(1) = txtcardno(0).Text        line.Fields(2) = txtID(1).Text        line.Fields(3) = txtname(4).Text        line.Fields(4) = txtdepartment(2).Text        line.Fields(5) = txtsex(5).Text        line.Fields(6) = StartDate        line.Fields(7) = StartTime        line.Fields(8) = EndDate        line.Fields(9) = EndTime        line.Fields(10) = alltime        line.Fields(11) = consumemoney        line.Fields(12) = cash        line.Fields(13) = "正常下机"        line.Fields(14) = VBA.Environ("computername")        line.Update        line.Close        MsgBox "下机成功！", vbOKCancel, "提示"        '清空信息        txtID(1).Text = ""        txtdepartment(2).Text = ""        txttype(3).Text = ""        txtname(4).Text = ""        txtsex(5).Text = ""        StartDate = ""        txtsdate(0).Text = ""        txtamount(2).Text = ""        txtstime(3).Text = ""        txtxdate(1).Text = ""        txtxtime(4).Text = ""        txtconsumetime(5).Text = ""        txtconsumepay(6).Text = ""        txttime.Text = ""        txtnumber.Text = ""        txtcardno(0).SetFocus        txtcardno(0).Text = ""        Label1.Caption = "" End IfEnd Sub