一、前提
当用户登录之后,注册一个卡号,可以进行上下机操作。
二、上机
上机代码:
Private Sub cmdOnline_Click()
Dim txtSQL As String
Dim MsgText As String
Dim mrc As ADODB.Recordset
Dim mrc1 As ADODB.Recordset 'OnLine_Info
Dim mrc2 As ADODB.Recordset 'Line_Info
Dim mrc3 As ADODB.Recordset 'Basicdata_Info
Dim miCount As Integer
txtType.Text = ""
txtStudentno.Text = ""
txtName.Text = ""
txtDepartment.Text = ""
comboSex.Text = ""
txtOnlinedate.Text = ""
txtOnlinetime.Text = ""
txtOfflinedate.Text = ""
txtOfflinetime.Text = ""
txtTime.Text = ""
txtRemaincash.Text = ""
txtUsedcash.Text = ""
'卡号是否为空
If txtCardno = "" Then
MsgBox "请输入卡号!", vbOKOnly, "提示"
txtCardno.SetFocus
txtCardno = ""
Exit Sub
End If
'卡号是否注册
txtSQL = "select * from student_Info where cardno='" & Trim(txtCardno.Text) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF Then
MsgBox "该卡号尚未注册,请重新输入!", vbOKOnly, "提示"
txtCardno.SetFocus
txtCardno = ""
Exit Sub
End If
'卡号是否在上机
txtSQL = "select * from OnLine_Info where cardno='" & Trim(txtCardno.Text) & "'"
Set mrc1 = ExecuteSQL(txtSQL, MsgText)
If mrc1.EOF = False Then
MsgBox "该卡号正在上机!", vbOKOnly, "提示"
txtCardno = ""
txtCardno.SetFocus
txtType.Text = ""
txtStudentno.Text = ""
txtName.Text = ""
txtDepartment.Text = ""
comboSex.Text = ""
txtOnlinedate.Text = ""
txtOnlinetime.Text = ""
txtOfflinedate.Text = ""
txtOfflinetime.Text = ""
txtTime.Text = ""
txtRemaincash.Text = ""
txtUsedcash.Text = ""
Exit Sub
End If
'卡号是否余额不足
If mrc.Fields(7) <= 5 Then
If MsgBox("该卡号余额不足,是否充值?", vbOKCancel, "提示") = vbOK Then
frmrecharge.Show , Me
End If
Exit Sub
End If
'卡号使用状态
If mrc.Fields(10) = "未使用" Then
If MsgBox("该卡尚未激活,是否修改学生信息?", vbOKCancel, "提示") = vbOK Then
frmmodifysinfo.Show , Me
End If
Exit Sub
End If
'是否设定基础数据
txtSQL = "select * from basicdata_Info"
Set mrc3 = ExecuteSQL(txtSQL, MsgText)
If mrc3.EOF Then
If MsgBox("该卡尚未设定基础数据,无法登录,是否设定?", vbOKCancel, "提示") = vbOK Then
frmsetbasicdata.Show , Me
End If
Exit Sub
End If
'上机成功,更新上机界面信息
txtSQL = "select * from student_Info where cardno='" & Trim(txtCardno.Text) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
'显示数据
txtStudentno.Text = Trim(mrc.Fields(1))
txtDepartment.Text = Trim(mrc.Fields(4))
txtType.Text = Trim(mrc.Fields(14))
txtName.Text = Trim(mrc.Fields(2))
comboSex.Text = Trim(mrc.Fields(3))
txtOnlinedate.Text = Trim(Date)
txtOnlinetime.Text = Trim(Time)
txtRemaincash.Text = Val(Trim(mrc.Fields(7)))
'更新上机表信息
txtSQL = "select * from OnLine_Info"
Set mrc1 = ExecuteSQL(txtSQL, MsgText)
mrc1.AddNew
mrc1.Fields(0) = Trim(txtCardno.Text)
mrc1.Fields(1) = Trim(txtType.Text)
mrc1.Fields(2) = Trim(txtStudentno.Text)
mrc1.Fields(3) = Trim(txtName.Text)
mrc1.Fields(4) = Trim(txtDepartment.Text)
mrc1.Fields(5) = Trim(comboSex.Text)
mrc1.Fields(6) = Trim(txtOnlinedate.Text)
mrc1.Fields(7) = Trim(txtOnlinetime.Text)
mrc1.Fields(8) = Trim("ZOEY")
mrc1.Fields(9) = Trim(Date)
mrc1.Update
lblOnlineNum.Caption = mrc1.RecordCount
'显示当前上机人数
mrc1.Close
'增加上机记录
txtSQL = "select * from Line_Info"
Set mrc2 = ExecuteSQL(txtSQL, MsgText)
mrc2.AddNew
mrc2.Fields(1) = Trim(txtCardno.Text)
mrc2.Fields(2) = Trim(txtStudentno.Text)
mrc2.Fields(3) = Trim(txtName.Text)
mrc2.Fields(4) = Trim(txtDepartment.Text)
mrc2.Fields(5) = Trim(comboSex.Text)
mrc2.Fields(6) = Trim(txtOnlinedate.Text)
mrc2.Fields(7) = Trim(txtOnlinetime.Text)
mrc2.Fields(13) = Trim("正常上机")
mrc2.Fields(14) = Trim("ZOEY")
mrc2.Update
mrc2.Close
'更新上机人数
txtSQL = "select count(*) from OnLine_Info "
Set mrc1 = ExecuteSQL(txtSQL, MsgText)
Label15.Caption = mrc1.RecordCount + 1
End Sub
三、下机
下机代码:
Private Sub cmdOffline_Click()
Dim txtSQL As String
Dim MsgText As String
Dim mrc As ADODB.Recordset 'student_info
Dim mrc1 As ADODB.Recordset 'bascidata_info
Dim mrc2 As ADODB.Recordset 'line_info
Dim mrc3 As ADODB.Recordset 'online_info
'卡号是否为空
If txtCardno = "" Then
MsgBox "请输入卡号!", vbOKOnly, "提示"
txtCardno.SetFocus
txtCardno = ""
Exit Sub
End If
'卡号是否存在
txtSQL = "select * from student_Info where cardno='" & Trim(txtCardno.Text) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
If mrc.EOF Then
MsgBox "不存在该卡号!", vbOKOnly, "提示"
txtCardno.SetFocus
txtCardno = ""
Exit Sub
End If
'卡号是否正在上机
txtSQL = "select * from OnLine_Info where cardno='" & Trim(txtCardno.Text) & "'"
Set mrc3 = ExecuteSQL(txtSQL, MsgText)
If mrc3.EOF Then
MsgBox "该用户未上机!", vbOKOnly, "提示"
txtCardno.SetFocus
txtCardno = ""
txtType.Text = ""
txtStudentno.Text = ""
txtName.Text = ""
txtDepartment.Text = ""
comboSex.Text = ""
txtOnlinedate.Text = ""
txtOnlinetime.Text = ""
txtOfflinedate.Text = ""
txtOfflinetime.Text = ""
txtTime.Text = ""
txtRemaincash.Text = ""
txtUsedcash.Text = ""
Exit Sub
End If
'更新界面信息
txtType.Text = Trim(mrc3.Fields(1))
txtStudentno.Text = Trim(mrc3.Fields(2))
txtName.Text = Trim(mrc3.Fields(3))
txtDepartment.Text = Trim(mrc3.Fields(4))
comboSex.Text = Trim(mrc3.Fields(5))
txtOnlinedate.Text = Trim(mrc3.Fields(6))
txtOnlinetime.Text = Trim(mrc3.Fields(7))
txtOfflinedate.Text = Trim(Date)
txtOfflinetime.Text = Trim(Time)
txtTime.Text = Trim(DateDiff("n", Trim(txtOnlinetime.Text), Trim(Time))) '把时间差转换为分钟
'从基本数据表获取数据
txtSQL = "select * from BasicData_Info "
Set mrc1 = ExecuteSQL(txtSQL, MsgText)
'计算消费金额
Dim MinTime As Integer
Dim AllTime As Single
Dim Rate As Single
Dim Money As Integer
MinTime = mrc1.Fields(3)
AllTime = txtTime.Text
'上机时间小于准备时间,不算时间,不花钱
If Trim(txtTime.Text) < MinTime Then
txtTime.Text = 0 & ""
Money = 0
Else
If AllTime > MinTime Then
Do While AllTime > MinTime
AllTime = AllTime - 30
If mrc.Fields(14) = "固定用户" Then
Money = Money + 2
Else
Money = Money + 3
End If
Loop
End If
End If
txtUsedcash.Text = Money
'计算余额
txtSQL = "select * from student_Info where cardno='" & Trim(txtCardno.Text) & "'and status='" & "使用" & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
txtRemaincash.Text = Val(Trim(mrc.Fields(7))) - Val(Trim(txtUsedcash.Text))
txtSQL = "Update student_Info set cash='" & Trim(txtUsedcash.Text) & "' where cardno='" & Trim(txtCardno.Text) & "'"
Set mrc = ExecuteSQL(txtSQL, MsgText)
MsgBox "下机成功!", vbOKOnly, "提示"
'更新Line表
txtSQL = "select * from Line_Info "
Set mrc2 = ExecuteSQL(txtSQL, MsgText)
If Not mrc2.EOF Then
mrc2.AddNew
mrc2.Fields(1) = Trim(txtCardno.Text)
mrc2.Fields(2) = Trim(txtStudentno.Text)
mrc2.Fields(3) = Trim(txtName.Text)
mrc2.Fields(4) = Trim(txtDepartment.Text)
mrc2.Fields(5) = Trim(comboSex.Text)
mrc2.Fields(6) = Trim(txtOnlinedate.Text)
mrc2.Fields(7) = Trim(txtOnlinetime.Text)
mrc2.Fields(8) = Trim(txtOfflinedate.Text)
mrc2.Fields(9) = Trim(txtOfflinetime.Text)
mrc2.Fields(10) = Trim(txtTime.Text)
mrc2.Fields(11) = Trim(txtUsedcash.Text)
mrc2.Fields(12) = Trim(txtRemaincash.Text)
mrc2.Fields(13) = "正常下机"
mrc2.Fields(14) = Trim(Environ("computername"))
mrc2.Update
mrc2.Close
End If
mrc3.Delete
'更新上机人数
txtSQL = "select count(*) from OnLine_Info "
Set mrc3 = ExecuteSQL(txtSQL, MsgText)
Label15.Caption = mrc3.RecordCount
End Sub
清空大脑,理清思路,考虑周全,按照自己想要的结果去执行就好了。