机房上下机是一个非常重要的功能,敲窗体之前一定要先搞请上下机逻辑关系,其次就是要把限定的条件想周到这样操作起来就容易多了。
上机,就是将以注册的,在用的,金额充足等符合上机要求的卡号进行上机。
上机流程图
一定要搞清楚上机的要求是什么?和那几个表相联系?在敲代码
上机部分展示
Private Sub Command1_Click()
'卡号是否为空
If txtCardNo = "" Then
MsgBox "请输入卡号!", 48, "提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
End If
'判断卡号是否为数字
If Not IsNumeric(Trim(txtCardNo.Text)) Then
MsgBox "请输入数字!", 48, "提示"
txtCardNo.SetFocus
txtCardNo.Text = ""
Exit Sub
End If
'判断卡号是否注册
txtsql = "select * from student_info where cardno ='" & txtCardNo.Text & "'"
Set mrc = ExecuteSQL(txtsql, msgtext)
If mrc.EOF = True Then
MsgBox "此卡号尚未注册!", 48, "提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
Else
'判断卡号是否注销
If Trim(mrc.Fields(10)) = Trim("未使用") Then
MsgBox "该卡已经注销", 48, "提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
Else
'判断是否上机
txtsql = "select * from online_info where cardno= '" & txtCardNo.Text & "'"
Set mrc1 = ExecuteSQL(txtsql, msgtext)
If mrc1.EOF = False Then
MsgBox "该卡正在上机,不能重复上机!", 48, "提示"
'显示该卡好的上机信息
txtType.Text = mrc1!cardtype
txtStudentNO.Text = mrc1!studentno
txtDept.Text = mrc1!department
txtName.Text = mrc1!studentname
ComboSex.Text = mrc1!sex
txtonDate.Text = mrc1!ondate
txtonTime.Text = mrc1!ontime
txtsql = "select * from student_info where cardno='" & txtCardNo.Text & "'"
Set mrc = ExecuteSQL(txtsql, msgtext)
txtBalance.Text = mrc!cash
'下机日期和时间要空着
txtoffDate.Text = ""
txtoffTime.Text = ""
costTime.Text = ""
costMoney.Text = ""
mrc.Update
mrc.Close
Exit Sub
Else
'若该卡没有上机,则显示上机信息
txtsql = "select * from student_info where cardno= '" & Trim(txtCardNo.Text) & "'"
Set mrc = ExecuteSQL(txtsql, msgtext)
If mrc.EOF = False Then
txtType.Text = mrc!Type
txtStudentNO.Text = mrc!studentno
txtDept.Text = mrc!department
txtName.Text = mrc!studentname
ComboSex.Text = mrc!sex
txtonDate.Text = Date
txtBalance.Text = mrc!cash
'获取系统时间
txtonTime.Text = Format(DateTime.Time, "hh:mm:ss")
txtBalance.Text = mrc!cash
End If
End If
End If
End If
'判断余额是否小于最小金额,如需要充值在上机,强制下机
txtsql = "select * from student_Info where cardno = '" & txtCardNo.Text & "'"
Set mrc = ExecuteSQL(txtsql, msgtext)
txtsql = "select * from basicdata_info "
Set mrc4 = ExecuteSQL(txtsql, msgtext)
If Val(mrc.Fields(7)) < Val(mrc4.Fields(5)) Then
MsgBox "余额小于最小限制金额,请充值后再上机!", 48, "提示"
txtCardNo.Text = ""
txtStudentNO.Text = ""
txtDept.Text = ""
txtType.Text = ""
txtName.Text = ""
ComboSex.Text = ""
txtonDate.Text = ""
txtonTime.Text = ""
txtBalance.Text = ""
txtCardNo.SetFocus
Exit Sub
End If
'更新online表
txtsql = "select * from OnLine_info"
Set mrc1 = ExecuteSQL(txtsql, msgtext)
mrc1.AddNew
mrc1!cardno = txtCardNo.Text
mrc1!studentno = txtStudentNO.Text
mrc1!department = txtDept.Text
mrc1!cardtype = txtType.Text
mrc1!studentname = txtName.Text
mrc1!sex = ComboSex.Text
mrc1!ondate = txtonDate.Text
mrc1!ontime = txtonTime.Text
mrc1!computer = Trim(VBA.Environ("computername"))
mrc1!Date = Date
mrc1.Update
mrc1.Close
'更新line表
txtsql = "select * from Line_info where cardno = '" & txtCardNo.Text & "'"
Set mrc2 = ExecuteSQL(txtsql, msgtext)
mrc2.AddNew
mrc2!cardno = txtCardNo.Text
mrc2!studentno = txtStudentNO.Text
mrc2!department = txtDept.Text
mrc2!studentname = txtName.Text
mrc2!sex = ComboSex.Text
mrc2!ondate = txtonDate.Text
mrc2!ontime = txtonTime.Text
mrc2!cash = txtBalance.Text
mrc2!Status = "正常上机"
mrc2!computer = Trim(VBA.Environ("computername"))
mrc2.Update
mrc2.Close
'更新上机人数
txtsql = "select count(*) from OnLine_info "
Set mrc1 = ExecuteSQL(txtsql, msgtext)
lblpeople.Caption = Trim(mrc1.Fields(0))
'更新临时用户数
txtsql = "select count(*) from OnLine_info where cardtype='临时用户 '"
Set mrc1 = ExecuteSQL(txtsql, msgtext)
lblplain.Caption = Trim(mrc1.Fields(0))
'更新固定用户数
txtsql = "select count(*) from OnLine_info where cardtype='固定用户 '"
Set mrc1 = ExecuteSQL(txtsql, msgtext)
lblmember.Caption = Trim(mrc1.Fields(0))
mrc1.Close
MsgBox "上机成功!", 48, "提示"
End Sub
上机相对还是蛮简单的,上机成功后一定要及时更新上机记录表,正在上机表
后期陆续更新,欢迎评论区留言!