第一次机房收费系统——无尽

        这是我的第一次机房收费系统，最近对上下机功能进行了学习。实现了，与大分享。


在这里，我将上机分为七个模块。按照如下的顺序只需要定义四个变量。既节省了内存，又便于修改。

<span style="font-size:18px;"><strong>Dim mrc As New ADODB.Recordset   '在一个库里，mrc可以重复使用。同时节省内存。Dim strsql As String  '这里最省内存Dim mrcBasicData As New ADODB.RecordsetDim mrcline As New ADODB.Recordset</strong></span>

<span style="font-size:18px;"><strong>Private Sub cmdMachineOn_Click()    '上机'模块一：判断卡号是否为空，判断卡号是否为数字If Trim(txtcardno.Text = "") ThenMsgBox "请输入卡号！", vbOKOnly + vbExclamation, "提示"txtcardno.SetFocusExit SubElse        If Not IsNumeric(Trim(txtcardno.Text)) Then        MsgBox "卡号必须输入数字！", vbOKOnly + vbExclamation, "提示"        txtcardno.Text = ""        txtcardno.SetFocus        Exit Sub        End IfEnd If'模块二：判断卡号是否注册，是否已经退卡。这里先查student_Info，mrc为以后方便用。strsql = "select * from student_Info where cardno= '" & Trim(txtcardno.Text) & "'"Set mrc = ExecuteSQL(strsql, "")If mrc.BOF And mrc.EOF ThenMsgBox "该卡号未注册，请先注册信息！", vbOKOnly + vbExclamation, "提示"txtcardno.Text = ""txtcardno.SetFocusExit SubElse        If Trim(mrc.Fields(10)) = "不使用" Then        MsgBox "该卡已经退卡", vbOKCancel + vbInformation, "提示"        txtcardno.Text = ""        txtcardno.SetFocus        Exit Sub        End IfEnd If'模块三：查BasicData_Info，判断是余额小于最小金额。strsql = "select * from BasicData_Info"Set mrcBasicData = ExecuteSQL(strsql, "")If Val(mrc.Fields(7)) < Val(mrcBasicData.Fields(5)) Then '这里mrc.Fields(7)用的很巧妙MsgBox "余额不足，请充值后上机！", vbOKOnly + vbExclamation, "提示"txtcardno.Text = ""txtcardno.SetFocusEnd If'模块四：查OnLine_Info，看该卡是否在上机strsql = "select * from OnLine_Info where cardno= '" & Trim(txtcardno.Text) & "'"Set mrc = ExecuteSQL(strsql, "")If mrc.EOF = False ThenMsgBox "该卡正在上机，不能重复上机！"txtcardno.Text = mrc.Fields(0)txttype.Text = mrc.Fields(1)txtstudentNo.Text = mrc.Fields(2)txtstudentName.Text = mrc.Fields(3)txtdepartment.Text = mrc.Fields(4)txtsex.Text = mrc.Fields(5)txtMachineOnDate.Text = mrc.Fields(6)txtMachineOnTime.Text = mrc.Fields(7)Exit SubEnd If'模块五：显示该卡号信息strsql = "select * from student_Info where cardno= '" & Trim(txtcardno.Text) & "'"Set mrc = ExecuteSQL(strsql, "")If mrc.EOF = False ThentxtstudentNo.Text = Trim(mrc.Fields(1))txtstudentName.Text = Trim(mrc.Fields(2))txtsex.Text = mrc.Fields(3)txtdepartment.Text = mrc.Fields(4)txttype.Text = mrc.Fields(14)txtMachineOnDate.Text = DatetxtMachineOnTime.Text = TimeEnd If'模块六：更新line_Info数据strsql = "select * from line_Info where cardno= '" & Trim(txtcardno.Text) & "'"Set mrcline = ExecuteSQL(strsql, "")mrcline.AddNewmrcline.Fields(1) = Trim(txtcardno.Text)mrcline.Fields(2) = Trim(txtstudentNo.Text)mrcline.Fields(3) = Trim(txtstudentName.Text)mrcline.Fields(4) = Trim(txtdepartment.Text)mrcline.Fields(5) = Trim(txtsex.Text)mrcline.Fields(6) = Trim(txtMachineOnDate.Text)mrcline.Fields(7) = Trim(txtMachineOnTime.Text)mrcline.Fields(12) = Trim(mrc.Fields(7))mrcline.Fields(13) = "正常上机"mrcline.Fields(14) = Trim(Environ("computername"))mrcline.Update'模块七：更新OnLine_Info数据strsql = "select * from OnLine_Info"Set mrc = ExecuteSQL(strsql, "")mrc.AddNewmrc.Fields(0) = Trim(txtcardno.Text)mrc.Fields(1) = Trim(txttype.Text)mrc.Fields(2) = Trim(txtstudentNo.Text)mrc.Fields(3) = Trim(txtstudentName.Text)mrc.Fields(4) = Trim(txtdepartment.Text)mrc.Fields(5) = Trim(txtsex.Text)mrc.Fields(6) = Datemrc.Fields(7) = Timemrc.Fields(8) = Trim(Environ("computername"))mrc.UpdateIf mrc.EOF = True Then  txtCurrentNumber.Text = 0ElsetxtCurrentNumber.Text = mrc.RecordCountEnd IfEnd SubPrivate Sub cmdMachineUp_Click()   '下机Dim intLineTime As Integer '用于存储实际在线时间Dim intconsume As SingleDim curConsume As Single '用于存储真正花费钱的时间Dim curBalance As Single '用于存储用户的余额Dim fixedunit As Single '用于存储单位金额Dim temunit As Single '用于存储单位金额Dim a As IntegerDim remaincash As Single'模块一：判断卡号是否为空，判断卡号是否为数字If Trim(txtcardno.Text = "") ThenMsgBox "请输入卡号！", vbOKOnly + vbExclamation, "提示"txtcardno.SetFocusExit SubElse        If Not IsNumeric(Trim(txtcardno.Text)) Then        MsgBox "卡号必须输入数字！", vbOKOnly + vbExclamation, "提示"        txtcardno.Text = ""        txtcardno.SetFocus        Exit Sub        End IfEnd If'模块二：判断卡号是否注册，是否已经退卡。这里先查student_Info，mrc为以后方便用。strsql = "select * from student_Info where cardno= '" & Trim(txtcardno.Text) & "'"Set mrc = ExecuteSQL(strsql, "")If mrc.BOF And mrc.EOF ThenMsgBox "该卡号未注册，请先注册信息！", vbOKOnly + vbExclamation, "提示"txtcardno.Text = ""txtcardno.SetFocusExit SubElse        If Trim(mrc.Fields(10)) = "不使用" Then            MsgBox "该卡已经退卡", vbOKCancel + vbInformation, "提示"            txtcardno.Text = ""            txtcardno.SetFocus            Exit Sub        End IfEnd If'模块八：判断改卡号是否在上机，没有上机不能退卡strsql = "select * from OnLine_Info where cardno= '" & Trim(txtcardno.Text) & "'"Set mrc = ExecuteSQL(strsql, "")If mrc.EOF = True ThenMsgBox "该卡没有上机，不能进行下机处理", vbOKOnly + vbExclamation, "警告"txtcardno.Text = ""txtcardno.SetFocusEnd IfintLineTime = (Date - DateValue(mrc!onDate)) * 1440 + (Hour(Time) - Hour(TimeValue(mrc!OnTime))) * 60 + (Minute(Time) - Minute(TimeValue(mrc!OnTime))) '时间单位为分钟strsql = "select * from student_Info where cardno= '" & Trim(txtcardno.Text) & "'"Set mrc = ExecuteSQL(strsql, "")'模块九：获得基本表的数据strsql = "select * from BasicData_Info"Set mrcBasicData = ExecuteSQL(strsql, "")mrcBasicData.MoveLast'单位时间的费用 （把固定用户，临时用户单位时间的费用分别赋值给费用）fixedunit = Val(mrcBasicData.Fields(0)) '把固定用户的金额赋值给变量temunit = Val(mrcBasicData.Fields(1)) '把临时用户的金额赋值给变量'判断在线时间是否小于准备时间，若小于则 消费金额=0If intLineTime <= Val(Trim(mrcBasicData.Fields(4))) ThentxtConsumptionAmount.Text = "0"Else'判断在线时间是否小于最低消费时间，若小于则为0     If intLineTime < Val(Trim(mrcBasicData.Fields(3))) Then     txtConsumptionAmount.Text = "0"     End IfEnd If '在线时间大于单位时间，就按有几个单位时间算，分为固定用户和临时用户If intLineTime >= Val(Trim(mrcBasicData!leasttime)) And intLineTime And Trim(mrc.Fields(14)) = "固定用户" Thena = Int(intLineTime / Val(Trim(mrcBasicData!unittime)))                If a = intLineTime / Trim(mrcBasicData!unittime) Then                    curConsume = a                Else                    curConsume = a + 1                End IftxtConsumptionAmount.Text = Val(curConsume) * Val(fixedunit)Else      If intLineTime >= Val(Trim(mrcBasicData!leasttime)) And intLineTime And Trim(mrc.Fields(14)) = "临时用户" Then      a = Int(intLineTime / Val(Trim(mrcBasicData!unittime)))                    If a = intLineTime / Trim(mrcBasicData!unittime) Then                        curConsume = a                    Else                        curConsume = a + 1                    End If      txtConsumptionAmount.Text = Val(curConsume) * Val(temunit)     End IfEnd If'模块十：更新学生表strsql = "select * from student_Info where cardno= '" & Trim(txtcardno.Text) & "'"Set mrc = ExecuteSQL(strsql, "")remaincash = mrc!cash - Val(txtConsumptionAmount.Text)    mrc.Fields(7) = remaincash    mrc.Update    mrc.Close    '模块十二：下机显示，删除在线表的信息strsql = "select * from OnLine_Info where cardno= '" & Trim(txtcardno.Text) & "'"Set mrc = ExecuteSQL(strsql, "")txtMachineUpDate.Text = DatetxtMachineUpTime.Text = Timetxttype = Trim(mrc.Fields(1))txtstudentNo = Trim(mrc.Fields(2))txtstudentName = Trim(mrc.Fields(3))txtdepartment = Trim(mrc.Fields(4))txtsex = Trim(mrc.Fields(5))txtMachineOnDate = Trim(mrc.Fields(6))txtMachineOnTime = Trim(mrc.Fields(7))txtDissipate.Text = intLineTimetxtcash.Text = remaincash'模块十一：更新上机记录表strsql = "select * from line_Info where cardno= '" & Trim(txtcardno.Text) & "'"Set mrcline = ExecuteSQL(strsql, "")mrcline.Fields(8) = Trim(txtMachineUpDate.Text)mrcline.Fields(9) = Trim(txtMachineUpTime.Text)mrcline.Fields(10) = Trim(txtDissipate.Text)mrcline.Fields(11) = Trim(txtConsumptionAmount.Text)mrcline.Fields(12) = Trim(txtcash.Text)mrcline.Fields(13) = Trim("正常下机")mrcline.UpdateMsgBox "下机成功，欢迎下次再来", vbOKOnly + vbExclamation, "警告"'删除在线表的信息mrc.Deletemrc.UpdatetxtCurrentNumber.Text = Str(Int(txtCurrentNumber.Text) - 1)End Sub</strong></span>