虽然在写代价时犯过很多逻辑错误,出现了很多漏洞,但是改了几次,都基本找出来了,但是对于退卡问题,我是真心伤了。。。。。。。。
一,退过卡的人,不能再次上机。
二, 每人只能退卡一次。
三,退卡人员的记录不能删除,要保留,但是在注册新用户时,不能用退卡人员的主键。
四,退卡的金额:什么都不写,默认全部退还。
五,退过卡的人不能再次充值。
If Trim(txtCardNum.Text) = "" Then '卡号为空的情况 MsgBox "卡号不能为空,请输入卡号!", vbOKOnly + vbExclamation, "警告" txtReturnRmb.Text = "" Exit Sub End If '先判断该学生是否存在 SQL = "select * from stubaseinfo where 卡号='" & Trim(txtCardNum.Text) & "' and 状态='使用'" Set Rst = ExecuteSQL(SQL, strMsg) If Rst.BOF And Rst.EOF Then '如果数据表中没有记录,则显示查无此卡的警告! MsgBox "此卡不存在!", vbOKOnly + vbExclamation, "警告" txtCardNum.Text = "" txtReturnRmb.Text = "" txtCardNum.SetFocus Exit Sub End If If Rst.EOF Then '如果数据表中有记录,但是查找不到该卡号 MsgBox "此卡不存在!请重新检查后输入!", vbOKOnly + vbInformation, "提示" txtCardNum.Text = "" txtCardNum.SetFocus Exit Sub Else '如果查找到该卡 '退卡钱先判断用户是否在上机 SQL = "select * from stuonline where 卡号='" & Trim(txtCardNum.Text) & "'" Set mrc = ExecuteSQL(SQL, strMsg) If Not (mrc.EOF And mrc.BOF) Then MsgBox "该用户正在上机,请稍后退卡!", vbOKOnly + vbInformation, "提示" txtCardNum.Text = "" txtReturnRmb.Text = "" Exit Sub End If '如果没有上机 lastRMB = Rst.Fields(9) '退卡钱金额的赋值 '如果没有填写退卡的金额,则默认为全部退还 If Trim(txtReturnRmb.Text) = "" Then txtReturnRmb.Text = lastRMB End If nowRMB = lastRMB - Val(Trim(txtReturnRmb.Text)) '计算退卡后卡里的钱 SQL = "update stubaseinfo set 金额='" & nowRMB & "',状态='不使用'" & " " & "where 卡号='" & Trim(txtCardNum.Text) & "'" '注意where前面一定要有个空格 Call ExecuteSQL(SQL, strMsg) '执行更新操作 listMsg.AddItem "退卡卡号:" & Trim(txtCardNum.Text) listMsg.AddItem "应退款金额:" & Trim(txtReturnRmb.Text) listMsg.AddItem "退卡日期:" & Format(GetSqlTime, "yyyy-mm-dd") listMsg.AddItem "退卡时间:" & Format(GetSqlTime, "hh:mm:ss") listMsg.AddItem "办理退卡教师:" & strUserName '写入退卡表里面 SQL = "insert into teareturncard values('" & Trim(txtCardNum.Text) & "','" & Trim(txtReturnRmb.Text) & "','" & strUserName & "','" & Format(GetSqlTime, "yyyy-mm-dd") & "','" & Format(GetSqlTime, "hh:mm:ss") & "','未结账')" Call ExecuteSQL(SQL, strMsg) '提示退卡成功,并清空文本框 If (MsgBox("退卡成功!退卡金额" & Trim(txtReturnRmb.Text), vbOKOnly + vbInformation, "提示")) Then txtCardNum.Text = "" txtReturnRmb.Text = "" listMsg.Clear Exit Sub End If End If