下机封装
机房收费系统有很多地方涉及到下机功能，我们可以将下机的代码封装起来，需要下机的时候直接调用，这样避免了代码冗余，逻辑也更容易捋顺。下面是代码：
'下机' Public Function OffLine(ByVal cardno, MsgString As String) Dim studentSQL, OnLineSQL, LineSQL, BasicDataSQL, MsgText As String'SQL前是表名，studentSQL就是存放连接student_Info的语句的' Dim mrcstudent, mrcOnLine, mrcLine, mrcBasicData As ADODB.Recordset'mrc后面的也是表名' Dim TTime, DTime '用来储存时间的差值和日期的差值' Dim CTime, CMoney, Balance As String '消费时间、消费金额、剩余金额' If Trim(cardno = "") Then MsgString = MsgBox("卡号不可为空！", 0, "系统提示") Exit Function Else studentSQL = "select * from student_info where cardno = '" & cardno & "'and status='使用'" Set mrcstudent = ExecuteSQL(studentSQL, MsgText) If mrcstudent.EOF Then MsgString = MsgBox("卡号尚未注册或被注销！", 0, "系统提示") Exit Function Else OnLineSQL = "select * from OnLine_Info where cardno = '" & cardno & "'" Set mrcOnLine = ExecuteSQL(OnLineSQL, MsgText) If mrcOnLine.EOF Then MsgString = MsgBox("未检测到卡号上机。", 0, "系统提示") mrcOnLine.Close Exit Function Else '把时间差转换为分钟' TTime = Trim(DateDiff("n", Trim(mrcOnLine.Fields(7)), Time)) '把日期差转换为分钟' DTime = Trim(DateDiff("n", Trim(mrcOnLine.Fields(6)), Date)) Set mrcBasicData = New ADODB.Recordset BasicDataSQL = "select * from BasicData_Info where head = '11'" Set mrcBasicData = ExecuteSQL(BasicDataSQL, MsgText) Set mrcstudent = New ADODB.Recordset studentSQL = "select * from student_info where cardno = '" & cardno & "'" Set mrcstudent = ExecuteSQL(studentSQL, MsgText) '如果上机时间小于准备时间，则上消费时间0，不产生消费;如大于准备时间，消费时间就等于时间差与日期差之和减去准备时间' If Val(TTime) + Val(DTime) < Val(mrcBasicData.Fields(3)) Then CTime = "0" CMoney = "0.00" Balance = mrcstudent!cash MsgString = "下机成功！卡号" & cardno & "上机时间过短，未产生消费！" Else CTime = Val(TTime) + Val(DTime) - Val(mrcBasicData.Fields(3)) '判断用户类型，临时用户3元/小时、固定用户2元/小时' If Trim(mrcOnLine.Fields(1)) = "固定用户" Then '计算固定用户消费金额和余额' CMoney = Int(Val(mrcBasicData.Fields(0)) / 60 * Val(CTime)) '如果消费金额为0，就改为一小时上网的费用' If CMoney = 0 Then CMoney = Val(mrcBasicData.Fields(0)) Balance = mrcstudent!cash - Val(CMoney) mrcstudent.Fields(7) = Val(Balance) mrcstudent.Update '更新student表中的余额' mrcstudent.Close mrcBasicData.Close Else '计算临时用户消费金额和余额' CMoney = Int(Val(mrcBasicData.Fields(1)) / 60 * Val(CTime)) If CMoney = 0 Then CMoney = Val(mrcBasicData.Fields(1)) Balance = Val(mrcstudent!cash) - Val(CMoney) mrcstudent.Fields(7) = Val(Balance) mrcstudent.Update '更新student表中的余额' mrcstudent.Close mrcBasicData.Close End If MsgString = "下机成功！" End If '更新Line表中的数据' LineSQL = "select * from Line_info where ontime= '" & Trim(mrcOnLine.Fields(7)) & "' and ondate= '" & Trim(mrcOnLine.Fields(6)) & "' and cardno= '" & cardno & "'" Set mrcLine = ExecuteSQL(LineSQL, MsgText) mrcLine.Fields(8) = Date mrcLine.Fields(9) = Time mrcLine.Fields(10) = Trim(CTime) mrcLine.Fields(11) = Trim(CMoney) mrcLine.Fields(12) = Trim(Balance) mrcLine.Fields(13) = "正常下机" mrcLine.Update mrcLine.Close '删除OnLine表中的信息' OnLineSQL = "delete from online_info where cardno='" & cardno & "'" Set mrcOnLine = ExecuteSQL(OnLineSQL, MsgText) '更新上机人数' OnLineSQL = "select * from OnLine_Info" Set mrcOnLine = ExecuteSQL(OnLineSQL, MsgText) lblPeople = mrcOnLine.RecordCount End If End If End If End Function
点击下机
在Main窗体可以实现点击按键上下机，上机就不多说了，下面是下机的代码：
'点击下机按钮' Private Sub cmdOffLine_Click() Dim LineSQL As String'SQL前是表名' Dim studentSQL As String Dim MsgText As String'存放查询数据库返回的结果' Dim MsgS As String '存放下机返回的结果' Dim mrcLine, mrcstudent As ADODB.Recordset'mrc后是表名' '调用封装好的下机方法' Call OffLine(txtCardNo.Text, MsgS) '如果返回的结果包含‘下机成功’就执行后面的代码' If InStr(1, MsgS, "下机成功") = 1 Then MsgBox MsgS, 0, "系统提示" studentSQL = "select * from student_Info where cardno='" & txtCardNo.Text & "'" Set mrcstudent = ExecuteSQL(studentSQL, MsgText) '更新窗体上的信息' txtType.Text = Trim(mrcstudent.Fields(14)) txtSID.Text = Trim(mrcstudent.Fields(1)) txtName.Text = Trim(mrcstudent.Fields(2)) txtDept.Text = Trim(mrcstudent.Fields(4)) txtSex.Text = Trim(mrcstudent.Fields(3)) '向Line表中查询同时满足卡号、上机时间和日期的数据' LineSQL = "select * from Line_info where ontime= '" & txtOnTime.Text & "' and ondate= '" & txtOnDate.Text & "' and cardno= '" & txtCardNo.Text & "'" Set mrcLine = ExecuteSQL(LineSQL, MsgText) '更新窗体上的信息' txtOnDate.Text = Trim(mrcLine.Fields(6)) txtOnTime.Text = Trim(mrcLine.Fields(7)) txtOffDate.Text = Trim(mrcLine.Fields(8)) txtOffTime.Text = Trim(mrcLine.Fields(9)) txtCTime.Text = Trim(mrcLine.Fields(10)) txtCMoney.Text = Trim(mrcLine.Fields(11)) txtBaLance.Text = Trim(mrcLine.Fields(12)) mrcstudent.Close mrcLine.Close End If End Sub
全员下机
'全部学生下机' Private Sub AllOffLine_Click() Dim Msg As String Dim OnLineSQL, MsgText As String Dim mrcOnLine As ADODB.Recordset '连接OnLine表' OnLineSQL = "select * from OnLine_Info" Set mrcOnLine = ExecuteSQL(OnLineSQL, MsgText) If mrcOnLine.EOF Then MsgBox "没有卡号在上机，请您稍后重试!", vbOKOnly + vbExclamation, "温馨提示" Exit Sub Else mrcOnLine.MoveFirst Do While Not mrcOnLine.EOF Call OffLine(mrcOnLine!cardno, Msg) mrcOnLine.MoveNext Loop End If MSFlexGrid1.Clear Call a MsgBox "所有学生下线成功!", vbOKOnly + vbExclamation, "温馨提示" End Sub
选择下机
这里借鉴了很多前辈的代码，熟练运用变量太重要了。
'鼠标单击选中事件' Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) '获取选中不连续行的权限，及实现多行选中' Dim col As Integer If MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 9) = "选中" Then MsgBox "请选择卡号下机！", vbOKOnly + vbExclamation, "温馨提示" Else If MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 9) = "√" Then MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 9) = "" '改变行颜色(变为没选中之前的）' For col = 0 To MSFlexGrid1.cols - 1 MSFlexGrid1.col = col MSFlexGrid1.CellBackColor = vbWhite Next col Else MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 9) = "√" '改变行颜色（选中后的颜色）' For col = 0 To MSFlexGrid1.cols - 1 MSFlexGrid1.col = col MSFlexGrid1.CellBackColor = vbYellow Next col End If End If AllOffLine.Enabled = True End Sub
'选择卡号下机' Private Sub SelectedOffLine_Click() Dim od(999) As String '存放上机日期' Dim ot(999) As String '存放上机时间' Dim sz(999) As String '这是一个数组，用来存储带“√”的学号' Dim xh(999) As String '用来存储带“√”的MSFlexGrid1的行号' Dim z As Integer '用来存储带“√”的学号用到的变量' Dim i As Integer '改变颜色时候调用的变量' Dim s As Integer '存带√的MSFlexGrid1的行号用到的变量' Dim j As Integer Dim t As Integer Dim Msg As String'存放下机返回的结果' '查看MSFlexGrid1表格控件，查看上机状态' If MSFlexGrid1.rows <= 1 Then MsgBox "没有卡号在上机，请您稍后重试!", vbOKOnly + vbExclamation, "温馨提示" Exit Sub End If '判断有无选择卡号再点击下机' If MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 9) = "√" Then MsgBox "选中的卡号正在下机中，请稍等!", vbOKOnly + vbExclamation, "温馨提示" Else MsgBox "您还没有选中卡号!", vbOKOnly + vbExclamation, "温馨提示" Exit Sub End If With MSFlexGrid1 '记录选中下机的卡号，在最后一行加了一个勾，将这些记录的所有卡号信息全部存到数组sz中' i = 0 For j = 1 To .rows - 1 If .TextMatrix(j, 9) = "√" Then sz(i) = .TextMatrix(j, 1) '存的是卡号' od(i) = .TextMatrix(j, 7) ot(i) = .TextMatrix(j, 8) xh(i) = Val(j) i = i + 1 End If Next j For z = 0 To i - 1 '数组是从0开始的' Call OffLine(sz(z), Msg)'调用下机' Next z '更新MSFlexGrid1的界面' For s = 0 To i - 1 .RemoveItem xh(s) Next s End With MsgBox "选中的卡号已下机成功！", vbOKOnly + vbExclamation, "温馨提示" End Sub
动态下机
我的计算方法是把余额转换成时间，以分钟为单位，接着10秒钟查询一遍所有登陆卡号的剩余时间，如果不足10分钟就提示充值，时间用尽就强制下机。
'动态下机' Private Sub Timer1_Timer() Dim OnLineSQL, TOnLineSQL, studentSQL, MsgText As String Dim mrcOnLine, mrcTOnLine, mrcstudent As ADODB.Recordset Dim i, a As Integer'放置卡号' Dim consumetime As Single '剩余分钟' Dim Msg As String'存放下机返回的结果' OnLineSQL = "select * from OnLine_Info" Set mrcOnLine = ExecuteSQL(OnLineSQL, MsgText) BasicDataSQL = "select * from BasicData_Info where head = '11'" Set mrcBasicData = ExecuteSQL(BasicDataSQL, MsgText) '判断是否有卡号上机' If mrcOnLine.EOF Then Timer1.Enabled = False Exit Sub Else mrcOnLine.MoveFirst End If '将上机卡号定义为一个数组' ReDim a(mrcOnLine.RecordCount) As String For i = 0 To mrcOnLine.RecordCount - 1 a(i) = Trim(mrcOnLine!cardno) '连接学生库查询卡号余额' studentSQL = "select * from student_Info where cardno='" & a(i) & "'" Set mrcstudent = ExecuteSQL(studentSQL, MsgText) '计算剩余时间（单位：分钟）' If Trim(mrcstudent!Type) = "固定用户" Then consumetime = Val(mrcstudent!cash) / Val(mrcBasicData.Fields(0)) * 60 + 2 consumetime = consumetime - Trim(DateDiff("n", Trim(mrcOnLine.Fields(7)), Time)) Else consumetime = Val(mrcstudent!cash) / Val(mrcBasicData.Fields(1)) * 60 + 2 consumetime = consumetime - Trim(DateDiff("n", Trim(mrcOnLine.Fields(7)), Time)) End If mrcOnLine.MoveNext '提醒充值，时间用尽就下机' If consumetime < 11 And consumetime > 10 Then MsgBox "上机剩余时间不足10分钟，请尽快充值，否则将会被强制下机！", 0 + 1, "系统提示" End If If consumetime < 2 Then '时间用尽了，调用下机' Call OffLine(a(i), Msg) MsgBox "卡号" & a(i) & ",剩余时间为零，下机完成！", 48, "系统提示" End If Next i End Sub
