机房收费系统(二)-上下机
【前言】
开始做机房时间也不短了,也看了不少大佬的博客,但是真的是每个人有每个人的思路,所以我也有了自己的思路。刚开始的时候没有什么思路,不知道如何下手,只有静下心来,一点点往下走,才能理清自己的思路。有些地方可能还存在不足,望指点。
【内容】
上机和下机导图
上机代码
Private Sub cmdOnLine_Click()
Dim MsgText As String
Dim Stusql As String
Dim OnLinesql As String
Dim Linesql As String
Dim BasicDatasql As String
Dim mrcStu As ADODB.Recordset
Dim mrcOnLine As ADODB.Recordset
Dim mrcLine As ADODB.Recordset
Dim mrcBasicData As ADODB.Recordset
'判断卡号是否为空
If txtCardNo.Text = "" Then
MsgBox "卡号不能为空,请输入卡号!", 48, "警告"
txtCardNo.SetFocus
Exit Sub
End If
'判断卡号是否为数字
If Not IsNumeric(Trim(txtCardNo.Text)) Then
MsgBox "请输入数字!", vbOKOnly + vbExclamation, "警告"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
End If
'判断该卡号是否已注册
Stusql = "select * from student_Info where cardno= '" & Trim(txtCardNo.Text) & "'"
Set mrcStu = ExecuteSQL(Stusql, MsgText)
If mrcStu.EOF = True Then
MsgBox "该卡号不存在,请注册!", 48, "警告"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
Else
'判断卡号是否退卡
If mrcStu.EOF Then
MsgBox "此卡已经退卡", vbOKOnly + vbExclamation, "提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
End If
End If
'判断余额是否充足
BasicDatasql = "select * from BasicData_Info"
Set mrcBasicData = ExecuteSQL(BasicDatasql, MsgText)
If mrcStu.Fields(7) < mrcBasicData.Fields(5) Then
MsgBox "余额不足,请先充值再上机!", 48, "提示"
Exit Sub
End If
'判断该卡号是否正在上机
OnLinesql = "select * from OnLine_Info where cardno='" & Trim(txtCardNo.Text) & "'"
Set mrcOnLine = ExecuteSQL(OnLinesql, MsgText)
If mrcOnLine.EOF = False Then
MsgBox "该卡正在上机,不能重复上机!", 64, "提示"
Exit Sub
End If
'调用学生信息到输入框
txtCardNo.Text = mrcStu.Fields(0)
txtType.Text = mrcStu.Fields(14)
txtSID.Text = mrcStu.Fields(1)
txtName.Text = mrcStu.Fields(2)
txtDept.Text = mrcStu.Fields(4)
comboSex.Text = mrcStu.Fields(3)
txtCash.Text = mrcStu.Fields(7)
txtOnDate.Text = Date
txtOnTime.Text = Time
txtOffDate.Text = ""
txtOffTime.Text = ""
txtCMoney.Text = ""
txtCTime = ""
'上机时将上机卡的数据同步至online_info表中
Set mrcOnLine = New ADODB.Recordset
OnLinesql = "select * from OnLine_info"
Set mrcOnLine = ExecuteSQL(OnLinesql, MsgText)
mrcOnLine.AddNew
mrcOnLine.Fields(0) = Trim(txtCardNo.Text)
mrcOnLine.Fields(1) = Trim(txtType.Text)
mrcOnLine.Fields(2) = Trim(txtSID.Text)
mrcOnLine.Fields(3) = Trim(txtName.Text)
mrcOnLine.Fields(4) = Trim(txtDept.Text)
mrcOnLine.Fields(5) = Trim(comboSex.Text)
mrcOnLine.Fields(6) = Trim(txtOnDate.Text)
mrcOnLine.Fields(7) = Trim(txtOnTime.Text)
mrcOnLine.Fields(8) = Trim(VBA.Environ("computername")) '将计算机名同步到数据库的相应表格中
lblAmount.Caption = mrcOnLine.RecordCount + 1 '显示上机人数
mrcOnLine.Update
mrcOnLine.Close
'上机时将上机卡的数据同步到line_info表中
Set mrcLine = New ADODB.Recordset
Linesql = "select * from line_info"
Set mrcLine = ExecuteSQL(Linesql, MsgText)
mrcLine.AddNew
mrcLine.Fields(1) = Trim(txtCardNo.Text)
mrcLine.Fields(2) = Trim(txtSID.Text)
mrcLine.Fields(3) = Trim(txtName.Text)
mrcLine.Fields(4) = Trim(txtDept.Text)
mrcLine.Fields(5) = Trim(comboSex.Text)
mrcLine.Fields(6) = Trim(txtOnDate.Text)
mrcLine.Fields(7) = Trim(txtOnTime.Text)
mrcLine.Fields(13) = "正常上机"
mrcLine.Fields(14) = Trim(VBA.Environ("computername"))
mrcLine.Update
mrcLine.Close
MsgBox "上机成功!", 64, "提示"
'显示正在上机的人数
OnLinesql = "select * from OnLine_Info"
Set mrcOnLine = ExecuteSQL(OnLinesql, MsgText)
If mrcOnLine.EOF = True Then
lblAmount.Caption = 0
Else
lblAmount.Caption = mrcOnLine.RecordCount
End If
End Sub
下机代码
Private Sub cmdOffLine_Click()
Dim MsgText As String
Dim Stusql As String
Dim OnLinesql As String
Dim BasicDatasql As String
Dim Linesql As String
Dim mrcStu As ADODB.Recordset
Dim mrcOnLine As ADODB.Recordset
Dim mrcBasicData As ADODB.Recordset
Dim mrcLine As ADODB.Recordset
'判断卡号是否为空
If Trim(txtCardNo.Text = "") Then
MsgBox "请输入卡号!", vbOKOnly + vbInformation, "温馨提示"
txtCardNo.SetFocus
Exit Sub
End If
'判断卡号是否为数字
If Not IsNumeric(txtCardNo.Text) Then
MsgBox "请输入数字!", vbOKOnly + vbInformation, "温馨提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
End If
'判断卡号是否存在
Stusql = "select * from student_info where cardno='" & txtCardNo.Text & "'" & "and status='使用" & "'"
Set mrcStu = ExecuteSQL(Stusql, MsgText)
If mrcStu.EOF = True Then
MsgBox "该卡未上机或已退卡,请重新输入卡号!", 48, "温馨提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
End If
'判断该卡是否正在上机
OnLinesql = "select * from online_info where cardno='" & txtCardNo.Text & "'"
Set mrcOnLine = ExecuteSQL(OnLinesql, MsgText)
If mrcOnLine.EOF = True Then
MsgBox "该卡未上机,请先上机再下机!", 64, "温馨提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
Else
txtCardNo.Text = mrcOnLine.Fields(0)
txtType.Text = mrcOnLine.Fields(1)
txtSID.Text = mrcOnLine.Fields(2)
txtName.Text = mrcOnLine.Fields(3)
txtDept.Text = mrcOnLine.Fields(4)
comboSex.Text = mrcOnLine.Fields(5)
txtOnDate.Text = mrcOnLine.Fields(6)
txtOnTime.Text = mrcOnLine.Fields(7)
txtOffTime.Text = Time
txtOffDate.Text = Format(Date, "yyyy-mm-dd")
'在线时长计算
linetime = (Date - DateValue(mrcOnLine!ondate)) * 1440 + (Hour(Time) - Hour(TimeValue(mrcOnLine!OnTime))) * 60 + (Minute(Time) - Minute(TimeValue(mrcOnLine!OnTime))) '时间单位为分钟
'计算消费金额;消费时间小于准备时间,则消费金额为0
BasicDatasql = "select * from basicdata_info "
Set mrcBasicData = ExecuteSQL(BasicDatasql, MsgText)
If Trim(linetime) <= Val(mrcBasicData.Fields(4)) Then
txtCMoney.Text = 0
txtCTime.Text = 0
Else
consumetime = Val(linetime) - Val(mrcBasicData.Fields(4))
txtCTime.Text = linetime
If Trim(txtType.Text) = "固定用户" Then
txtCMoney.Text = Format(consumetime / mrcBasicData.Fields(2) * mrcBasicData.Fields(0), "0.00")
Else
txtCMoney.Text = Format(consumetime / mrcBasicData.Fields(2) * mrcBasicData.Fields(1), "0.00")
End If
End If
'计算余额
txtCash.Text = Val(mrcStu.Fields(7)) - Val(Trim(txtCMoney.Text))
'将余额更新到student表中
mrcStu.Fields(7) = Val(Trim(txtCash.Text))
mrcStu.Update
mrcStu.Close
End If
'删除line表中上机的信息
Linesql = "select * from line_info where cardno='" & txtCardNo.Text & "'"
Set mrcLine = ExecuteSQL(Linesql, MsgText)
mrcLine.Delete
mrcLine.Update
mrcLine.Close
'更新Line表
Linesql = "select * from line_info where cardno='" & txtCardNo.Text & "'"
Set mrcLine = ExecuteSQL(Linesql, MsgText)
With mrcLine
.AddNew
.Fields(1) = Trim(txtCardNo.Text)
.Fields(2) = Trim(txtSID.Text)
.Fields(3) = Trim(txtName.Text)
.Fields(4) = Trim(txtDept.Text)
.Fields(5) = Trim(comboSex.Text)
.Fields(6) = mrcOnLine!ondate
.Fields(7) = mrcOnLine!OnTime
!COMPUTER = VBA.Environ("computername")
!offdate = Trim(txtOffDate.Text)
!offtime = Trim(txtOffTime.Text)
!consumetime = Trim(txtCTime.Text)
!consume = Trim(txtCMoney.Text)
!cash = Trim(txtCash.Text) & ""
!Status = "正常下机"
.Update
.Close
End With
'更新online表
mrcOnLine.Delete
mrcOnLine.Update
mrcOnLine.Close
'显示正在上机的人数
OnLinesql = "select * from OnLine_Info"
Set mrcOnLine = ExecuteSQL(OnLinesql, MsgText)
If mrcOnLine.EOF = True Then
lblAmount.Caption = 0
Else
lblAmount.Caption = mrcOnLine.RecordCount
End If
End Sub