本文主要是介绍机房收费系统总结之上下机,希望对大家解决编程问题提供一定的参考价值,需要的开发者们随着小编来一起学习吧!
一:上机:
条件:1:卡号是否为空 2:卡号是否注册 3:卡号是否状态为正在使用(退卡的 学生不能再次上机的)4:余额不能为0,思路就是这样的,比较简单
整体过程: 满足条件——添加online记录——更新student记录
代码:
If kahao.Text = "" ThenMsgBox "请输入卡号"Exit Subkahao.SetFocuskahao.Text = ""
End Iftxtsql2 = "select * from online_info "Set mrc2 = ExecuteSQL(txtsql2, msgtext2)
If mrc2.EOF = False Thenv = Trim(mrc2!cardno)If v = Trim(kahao.Text) ThenMsgBox "该卡号已经上机", vbOKOnly + vbExclamation, "提示"Exit Subkahao.Text = ""kahao.SetFocusEnd If
End Iftxtsql = "select * from student_Info where cardno='" & kahao.Text & "'and status='正在使用'and cash<>0"Set mrc = ExecuteSQL(txtsql, msgtext)
If mrc.EOF = False Thenkahao.Text = mrc.Fields(0)txtstudentname.Text = mrc.Fields(2)txtsex.Text = mrc.Fields(4)txtdepartment.Text = mrc.Fields(3)txttype.Text = mrc.Fields(14)txtstudentno.Text = mrc.Fields(1)txtondate.Text = Datetxtontime.Text = Timemrc.Closetxtsql1 = "select * from Online_info "
'strInSQL = "insert into OnLine_Info values('" & kahao.Text & "','" & leixing.Text & "'," & xuehao.Text & "," & xingming.Text & "," & xibie.Text & ",'" & xingbie.Text & "','" & Date & "','" & Time & "','" & Winsock1.LocalHostName & "','" & Now & "')"
Set mrc1 = ExecuteSQL(txtsql1, msgtext1)mrc1.AddNewmrc1.Fields(0) = Trim(kahao.Text)mrc1.Fields(1) = Trim(txttype.Text)mrc1.Fields(2) = Trim(txtstudentno.Text)mrc1.Fields(3) = Trim(txtstudentname.Text)mrc1.Fields(4) = Trim(txtdepartment.Text)mrc1.Fields(5) = Trim(txtsex.Text)mrc1.Fields(6) = Trim(Date)mrc1.Fields(7) = Trim(Time)mrc1.Fields(8) = Trim(Winsock1.LocalHostName)mrc1.Fields(9) = Trim(Now)mrc1.Updateshangjirenshu.Caption = mrc1.RecordCountmrc1.Close
ElseMsgBox "卡号不正确或者此卡已经退卡或者余额不足,请查看", vbOKOnly + vbExclamation, "上机"
End If
二:下机:
(1)满足条件:1:卡号是否为空 2:卡号是否注册和是否正在上机
(2)整体过程:满足条件——计算消费时间——计算消费金额——更新student表,更新online表,更新line表
(3)消费时间和消费金额的计算:
a=准备时间 b=至少上机时间 c=消费时间长于准备时间和至少上机时间
在准备时间里,是不收费的,也就是消费额是为0;在至少上机时间里面,收取消费金额是固定的,设为1;多余准备时间和至少上机时间里面,收取的金额是按照每小时消费60分钟来增加的,同时,在这个时间段里面,需要区分固定用户和临时用户。
设消费时间为x,消费金额为y,则可以用下面的图来表示
(4)代码:
If Testtxt(kahao.Text) = False ThenMsgBox "请输入卡号!", vbOKOnly + vbExclamation, "提示"kahao.Text = ""kahao.SetFocusExit Sub
End If'判断该卡号是否注册和状态是否正在使用Set mrc1 = New ADODB.Recordsettxtsql1 = "select * from student_Info where cardno='" & kahao.Text & "'and status='正在使用'"Set mrc1 = ExecuteSQL(txtsql1, msgtext1)
If mrc1.EOF And mrc1.BOF ThenMsgBox "该卡号未注册!", vbOKOnly + vbExclamation, "提示"kahao.Text = ""kahao.SetFocusExit Sub
End If'判断该卡号是否上机Set mrc2 = New ADODB.Recordsettxtsql2 = "select * from OnLine_Info where cardno='" & kahao.Text & "'"Set mrc2 = ExecuteSQL(txtsql2, msgtext2)If mrc2.EOF And mrc2.BOF ThenMsgBox "该卡号没有上机!", vbOKOnly + vbExclamation, "提示"kahao.Text = ""kahao.SetFocusExit SubElsekahao.Text = Trim(mrc2.Fields(0))txttype.Text = Trim(mrc2.Fields(1))txtstudentno.Text = Trim(mrc2.Fields(2))txtstudentname.Text = Trim(mrc2.Fields(3))txtdepartment.Text = Trim(mrc2.Fields(4))txtsex.Text = Trim(mrc2.Fields(5))txtondate.Text = Trim(mrc2.Fields(6))txtontime.Text = Trim(mrc2.Fields(7))txtoffdate.Text = Datetxtofftime.Text = Time'计算消费时间StartTime = Format(mrc2.Fields(7), "hh:mm:ss")EndTime = Format(Time, "hh:mm:ss")txtconsumetime.Text = Format(Time, "hh:mm:ss")txtconsumetime.Text = DateDiff("n", Trim(StartTime), Trim(EndTime))'计算消费金额StrType = Trim(mrc1.Fields(14)) '获取用户类型,用于判断单位价格OldCash = Val(mrc1.Fields(7)) '获取用户余额'在basicdata表中获取基本数据txtsql3 = "select * from BasicData_Info "Set mrc3 = ExecuteSQL(txtsql3, msgtext3)leasttime = Trim(mrc3.Fields(3))preparetime = Trim(mrc3.Fields(4))If Val(Trim(txtconsumetime.Text)) < preparetime Thentxtcash = OldCashtxtconsume.Text = "0.0"End IfIf Val(Trim(txtconsumetime.Text)) <= (leasttime + preparetime) Thentxtconsume.Text = "1.0"txtcash.Text = OldCash - 1
ElseSelect Case StrTypeCase "固定用户"StrRate = Val(Trim(mrc3.Fields(0)))txtconsume.Text = 1 + Round(txtconsumetime.Text - leasttime - preparetime) / 60 * StrRatetxtcash.Text = OldCash - txtconsume.TextCase "临时用户"StrRate = Val(Trim(mrc3.Fields(1)))txtconsume.Text = 1 + Round((txtconsumetime.Text - leasttime - preparetime) / 60) * StrRatetxtcash.Text = OldCash - txtconsume.TextEnd SelectEnd If'更新student表
txtsql1 = "update student_Info set cash=" & txtcah & " where cardno='" & kahao.Text & "'"
Set mrc1 = ExecuteSQL(txtsql1, msgtext1)'更新OnLine表
txtsql2 = "delete OnLine_Info where cardno='" & kahao.Text & "'"
Set mrc2 = ExecuteSQL(txtsql2, msgtext2)txtsql2 = "select * from OnLine_Info "
Set mrc2 = ExecuteSQL(txtsql2, msgtext2)
shangjirenshu.Caption = mrc2.RecordCount '获取新的上机人数
mrc2.Close'更新Line表
txtsql4 = "select * from Line_Info"
Set mrc4 = ExecuteSQL(txtsql4, msgtext4)
mrc4.AddNew
mrc4.Fields(1) = Trim(kahao.Text)
mrc4.Fields(2) = Trim(txtstudentno.Text)
mrc4.Fields(3) = Trim(txtstudentname.Text)
mrc4.Fields(4) = Trim(txtdepartment.Text)
mrc4.Fields(5) = Trim(txtsex.Text)
mrc4.Fields(6) = Trim(txtondate.Text)
mrc4.Fields(7) = Trim(txtontime.Text)
mrc4.Fields(8) = Trim(txtoffdate.Text)
mrc4.Fields(9) = Trim(txtofftime.Text)
mrc4.Fields(10) = Trim(txtconsumetime.Text)
mrc4.Fields(11) = Trim(txtconsume.Text)
mrc4.Fields(12) = Trim(Val(NewCash))
mrc4.Fields(13) = "正常下机"
mrc4.Fields(14) = Trim(Winsock1.LocalHostName)
mrc4.Update
mrc4.CloseMsgBox "下机成功", vbOKOnly + vbExclamation, "提示"Exit Sub
End IfEnd Sub
就这样,上下机的问题解决啦!!!
欢迎纠错!!!!!
If kahao.Text = "" ThenMsgBox "请输入卡号"Exit Subkahao.SetFocuskahao.Text = ""
End Iftxtsql2 = "select * from online_info "Set mrc2 = ExecuteSQL(txtsql2, msgtext2)
If mrc2.EOF = False Thenv = Trim(mrc2!cardno)If v = Trim(kahao.Text) ThenMsgBox "该卡号已经上机", vbOKOnly + vbExclamation, "提示"Exit Subkahao.Text = ""kahao.SetFocusEnd If
End Iftxtsql = "select * from student_Info where cardno='" & kahao.Text & "'and status='正在使用'and cash<>0"Set mrc = ExecuteSQL(txtsql, msgtext)
If mrc.EOF = False Thenkahao.Text = mrc.Fields(0)txtstudentname.Text = mrc.Fields(2)txtsex.Text = mrc.Fields(4)txtdepartment.Text = mrc.Fields(3)txttype.Text = mrc.Fields(14)txtstudentno.Text = mrc.Fields(1)txtondate.Text = Datetxtontime.Text = Timemrc.Closetxtsql1 = "select * from Online_info "
'strInSQL = "insert into OnLine_Info values('" & kahao.Text & "','" & leixing.Text & "'," & xuehao.Text & "," & xingming.Text & "," & xibie.Text & ",'" & xingbie.Text & "','" & Date & "','" & Time & "','" & Winsock1.LocalHostName & "','" & Now & "')"
Set mrc1 = ExecuteSQL(txtsql1, msgtext1)mrc1.AddNewmrc1.Fields(0) = Trim(kahao.Text)mrc1.Fields(1) = Trim(txttype.Text)mrc1.Fields(2) = Trim(txtstudentno.Text)mrc1.Fields(3) = Trim(txtstudentname.Text)mrc1.Fields(4) = Trim(txtdepartment.Text)mrc1.Fields(5) = Trim(txtsex.Text)mrc1.Fields(6) = Trim(Date)mrc1.Fields(7) = Trim(Time)mrc1.Fields(8) = Trim(Winsock1.LocalHostName)mrc1.Fields(9) = Trim(Now)mrc1.Updateshangjirenshu.Caption = mrc1.RecordCountmrc1.Close
ElseMsgBox "卡号不正确或者此卡已经退卡或者余额不足,请查看", vbOKOnly + vbExclamation, "上机"
End If
If Testtxt(kahao.Text) = False ThenMsgBox "请输入卡号!", vbOKOnly + vbExclamation, "提示"kahao.Text = ""kahao.SetFocusExit Sub
End If'判断该卡号是否注册和状态是否正在使用Set mrc1 = New ADODB.Recordsettxtsql1 = "select * from student_Info where cardno='" & kahao.Text & "'and status='正在使用'"Set mrc1 = ExecuteSQL(txtsql1, msgtext1)
If mrc1.EOF And mrc1.BOF ThenMsgBox "该卡号未注册!", vbOKOnly + vbExclamation, "提示"kahao.Text = ""kahao.SetFocusExit Sub
End If'判断该卡号是否上机Set mrc2 = New ADODB.Recordsettxtsql2 = "select * from OnLine_Info where cardno='" & kahao.Text & "'"Set mrc2 = ExecuteSQL(txtsql2, msgtext2)If mrc2.EOF And mrc2.BOF ThenMsgBox "该卡号没有上机!", vbOKOnly + vbExclamation, "提示"kahao.Text = ""kahao.SetFocusExit SubElsekahao.Text = Trim(mrc2.Fields(0))txttype.Text = Trim(mrc2.Fields(1))txtstudentno.Text = Trim(mrc2.Fields(2))txtstudentname.Text = Trim(mrc2.Fields(3))txtdepartment.Text = Trim(mrc2.Fields(4))txtsex.Text = Trim(mrc2.Fields(5))txtondate.Text = Trim(mrc2.Fields(6))txtontime.Text = Trim(mrc2.Fields(7))txtoffdate.Text = Datetxtofftime.Text = Time'计算消费时间StartTime = Format(mrc2.Fields(7), "hh:mm:ss")EndTime = Format(Time, "hh:mm:ss")txtconsumetime.Text = Format(Time, "hh:mm:ss")txtconsumetime.Text = DateDiff("n", Trim(StartTime), Trim(EndTime))'计算消费金额StrType = Trim(mrc1.Fields(14)) '获取用户类型,用于判断单位价格OldCash = Val(mrc1.Fields(7)) '获取用户余额'在basicdata表中获取基本数据txtsql3 = "select * from BasicData_Info "Set mrc3 = ExecuteSQL(txtsql3, msgtext3)leasttime = Trim(mrc3.Fields(3))preparetime = Trim(mrc3.Fields(4))If Val(Trim(txtconsumetime.Text)) < preparetime Thentxtcash = OldCashtxtconsume.Text = "0.0"End IfIf Val(Trim(txtconsumetime.Text)) <= (leasttime + preparetime) Thentxtconsume.Text = "1.0"txtcash.Text = OldCash - 1
ElseSelect Case StrTypeCase "固定用户"StrRate = Val(Trim(mrc3.Fields(0)))txtconsume.Text = 1 + Round(txtconsumetime.Text - leasttime - preparetime) / 60 * StrRatetxtcash.Text = OldCash - txtconsume.TextCase "临时用户"StrRate = Val(Trim(mrc3.Fields(1)))txtconsume.Text = 1 + Round((txtconsumetime.Text - leasttime - preparetime) / 60) * StrRatetxtcash.Text = OldCash - txtconsume.TextEnd SelectEnd If'更新student表
txtsql1 = "update student_Info set cash=" & txtcah & " where cardno='" & kahao.Text & "'"
Set mrc1 = ExecuteSQL(txtsql1, msgtext1)'更新OnLine表
txtsql2 = "delete OnLine_Info where cardno='" & kahao.Text & "'"
Set mrc2 = ExecuteSQL(txtsql2, msgtext2)txtsql2 = "select * from OnLine_Info "
Set mrc2 = ExecuteSQL(txtsql2, msgtext2)
shangjirenshu.Caption = mrc2.RecordCount '获取新的上机人数
mrc2.Close'更新Line表
txtsql4 = "select * from Line_Info"
Set mrc4 = ExecuteSQL(txtsql4, msgtext4)
mrc4.AddNew
mrc4.Fields(1) = Trim(kahao.Text)
mrc4.Fields(2) = Trim(txtstudentno.Text)
mrc4.Fields(3) = Trim(txtstudentname.Text)
mrc4.Fields(4) = Trim(txtdepartment.Text)
mrc4.Fields(5) = Trim(txtsex.Text)
mrc4.Fields(6) = Trim(txtondate.Text)
mrc4.Fields(7) = Trim(txtontime.Text)
mrc4.Fields(8) = Trim(txtoffdate.Text)
mrc4.Fields(9) = Trim(txtofftime.Text)
mrc4.Fields(10) = Trim(txtconsumetime.Text)
mrc4.Fields(11) = Trim(txtconsume.Text)
mrc4.Fields(12) = Trim(Val(NewCash))
mrc4.Fields(13) = "正常下机"
mrc4.Fields(14) = Trim(Winsock1.LocalHostName)
mrc4.Update
mrc4.CloseMsgBox "下机成功", vbOKOnly + vbExclamation, "提示"Exit Sub
End IfEnd Sub
这篇关于机房收费系统总结之上下机的文章就介绍到这儿,希望我们推荐的文章对编程师们有所帮助!