在敲机房管理系统的一段时间内,感觉最难的就是上下机问题。这里运用了大量的计算。下面是我的源代码展示:
上机时:首先,判断上机卡号是否为已经注册的卡号Studnet_Info表。然后,判断该卡是否正在上机Online_Info表。在判断余额是否大于上机最低金额BasicData_Info表。
下机时:首先输入下机卡号。Studnet_Info表中判断该卡号是否存在,如果不存在提示注册。如果存在,判断Online_Info中是否正在上机,如果正在上机将此记录删除。然后在Line_Info表中填入数据。如果没有上机则提示没有上机信息,上机则进行数值计算和显示。最后更新Studnet_Info表中的cash余额,用总的减去消费的。
下机代码:
</pre><pre name="code" class="vb">private Sub cmddown_Click()
Dim txtSQL As String
Dim txtSQL2 As String
Dim txtSQL3 As String
Dim txtSQL4 As String
Dim Msgtext As String
Dim MsgText2 As String
Dim MsgText3 As String
Dim MsgText4 As String
Dim mrc As ADODB.Recordset
Dim Object As ADODB.Recordset
Dim Object2 As ADODB.Recordset
Dim Object3 As ADODB.Recordset
Dim ondate As Date
Dim ontime As Date
Dim txtdate As Single
Dim txttime As Single
Dim Outdate As Date
Dim Outtime As Date
Dim Style As String
Dim inttime As Single
Dim Balance As Single
Dim basicPay As Single
Dim returnCash As Single
If Not Testtxt(txtcard.Text) Then
MsgBox "请输入下机卡号", vbOKOnly + vbExclamation, "警告"
Exit Sub
End If
txtSQL = "select * from student_Info where cardno = '" & txtcard.Text & "' "
Set mrc = ExecuteSQL(txtSQL, Msgtext)
'判断卡号是否存在
If mrc.BOF And mrc.EOF Then '如果不存在则给出提示
MsgBox "卡号不存在,请重新输入或重新注册!", vbOKOnly + vbExclamation, "警告"
txtcard.SetFocus
Exit Sub
Else '如果存在,则判断是否正在上机
Balance = Trim(mrc.Fields(7))
txtSQL2 = "select * from Online_Info where cardno = '" & txtcard.Text & "' "
Set Object = ExecuteSQL(txtSQL2, MsgText2)
If Object.BOF And Object.EOF Then '卡号没有上机,则给出提示
MsgBox "该卡号没有在上机,不能进行下机处理", vbOKOnly + vbExclamation, "警告"
txtcard.SetFocus
Exit Sub
Else
'上机时间计算
txtShangdate.Text = Trim(Object.Fields(6)) 'ondate上机日期
txtShangTime.Text = Trim(Object.Fields(7)) 'ontime上机时间
txtStudentNO.Text = Trim(Object.Fields(2)) 'StudentNo学号
txtUserName.Text = Trim(Object.Fields(3)) '姓名
txtXiBie.Text = Trim(Object.Fields(4)) '系别
txtsex.Text = Trim(Object.Fields(5)) '性别
txtOuttime.Text = Format(Time, "hh:mm:ss") '下机时间
txtOutdate.Text = Format(Date, "yyyy-mm-dd") '下机日期
txtBalance.Text = Balance '余额
Outdate = Format(txtOutdate.Text, "yyyy-mm-dd")
Outtime = Format(txtOuttime.Text, "hh:mm:ss")
ondate = Format(Trim(Object.Fields(6)), "yyyy-mm-dd")
ontime = Format(Trim(Object.Fields(7)), "hh:mm:ss")
txtdate = DateDiff("n", ondate, Outdate)
txttime = DateDiff("n", ontime, Outtime) 'DateDiff求时间差值
txtConsumeMin.Text = Int(txttime) + Int(txtdate)
inttime = txtConsumeMin.Text
Style = Trim(Object.Fields(1))
txtstyle.Text = Style '类型
'上机金额计算
txtSQL3 = "select * from BasicData_Info "
Set Object2 = ExecuteSQL(txtSQL3, MsgText3)
If Style = "固定用户" Then '判断用户类型
basicPay = Val(Trim(Object2.Fields(0)))
'判断上机时间是否超过准备时间
If inttime < Val(Object2.Fields(4)) Then
txtConsumeMin.Text = 0
txtConsumeMoney.Text = 0
returnCash = Val(Trim(txtBalance.Text) - Trim(txtConsumeMoney.Text))
txtBalance.Text = returnCash
mrc.Fields(7) = txtBalance.Text
mrc.Update
Call Panduan
Else '判断上机时间是否超过最短时间
txtConsumeMin.Text = inttime '在窗体上显示上网时间
If inttime <= Val(Object2.Fields(3)) Then '没超过最短时间按最短时间收费
txtConsumeMoney.Text = basicPay
returnCash = Trim(txtBalance.Text) - Trim(txtConsumeMoney.Text)
txtBalance.Text = returnCash
mrc.Fields(7) = txtBalance.Text
mrc.Update
Call Panduan
Else
'超过最短时间,判断消耗的时间是否正好是要求时间的倍数,判断是不是有超出不满足要求时间的部分,这部分仍然按照要求时间收费
If Val(inttime) Mod 30 = 0 Then '消耗时间,正好等于要求的单位时间
txtConsumeMoney.Text = Val(inttime) \ 30 * basicPay \ 2
returnCash = Trim(txtBalance.Text) - Trim(txtConsumeMoney.Text)
txtBalance.Text = returnCash
mrc.Fields(7) = txtBalance.Text '更新student_Info表中的cash余额
mrc.Update
Call Panduan
Else
txtConsumeMoney.Text = (Val(inttime) \ 30 + 1) * basicPay \ 2
returnCash = Val(Trim(txtBalance.Text) - Trim(txtConsumeMoney.Text))
txtBalance.Text = returnCash
mrc.Fields(7) = txtBalance.Text '更新student_Info表中的cash余额
mrc.Update
Call Panduan
End If
End If
End If
Else '临时用户的消费计算方式
basicPay = Val(Trim(Object2.Fields(1)))
If inttime < Val(Object2.Fields(4)) Then
txtConsumeMin.Text = 0
txtConsumeMoney.Text = 0
returnCash = Trim(txtBalance.Text) - Trim(txtConsumeMoney.Text)
txtBalance.Text = returnCash
mrc.Fields(7) = txtBalance.Text '更新student_Info表中的cash余额
mrc.Update
Call Panduan
Else
txtConsumeMin.Text = inttime
If inttime <= Val(Object2.Fields(3)) Then
txtConsumeMoney.Text = basicPay
returnCash = Trim(txtBalance.Text) - Trim(txtConsumeMoney.Text)
txtBalance.Text = returnCash
mrc.Fields(7) = txtBalance.Text '更新student_Info表中cash余额
mrc.Update
Call Panduan
Else
If Val(inttime) Mod 30 = 0 Then
txtConsumeMoney.Text = Val(inttime) \ 30 * basicPay \ 2
returnCash = Trim(txtBalance.Text) - Trim(txtConsumeMoney.Text)
txtBalance.Text = returnCash
mrc.Fields(7) = txtBalance.Text '更新student_Info表中的cash余额
mrc.Update
Call Panduan
Else
txtConsumeMoney.Text = (Val(inttime) \ 30 + 1) * basicPay \ 2
returnCash = Trim(txtBalance.Text) - Trim(txtConsumeMoney.Text)
txtBalance.Text = returnCash
mrc.Fields(7) = txtBalance.Text '更新到student_Info表中的cash余额
mrc.Update
Call Panduan
End If
End If
End If
End If
End If
End If
End Sub
上机代码:
<span style="font-family: Arial, Helvetica, sans-serif;"></span>
Private Sub cmdup_Click()
Dim mrc As ADODB.Recordset
Dim txtSQL As String
Dim Msgtext As String
Dim cash As Double
Dim Object As ADODB.Recordset
Dim txtSQL2 As String
Dim MsgText2 As String
txtSQL2 = "select * from BasicData_Info"
Set Object = ExecuteSQL(txtSQL2, MsgText2)
If Not Testtxt(Trim(txtcard.Text)) Then
MsgBox "请输入准备上机的卡号", vbOKOnly + vbExclamation, "警告" '判断要上机的卡号是否为空
Exit Sub
End If
txtSQL = "select * from student_Info where cardno = '" & txtcard.Text & "' "
Set mrc = ExecuteSQL(txtSQL, Msgtext)
'判断student_Info表中是否存在该卡号
If mrc.BOF And mrc.EOF Then '如果不存在
MsgBox "该卡号没有注册请重新输入", vbOKOnly + vbExclamation, 警告"
txtcard.Text = ""
txtcard.SetFocus
Else
cash = Trim(mrc.Fields(7)) '获取上机卡号的余额
txtSQL = "select * from Online_Info where cardno = '" & txtcard.Text & "' " '判断该卡号是否正在上机
Set mrc = ExecuteSQL(txtSQL, Msgtext)
If mrc.EOF Then
If cash < Trim(Object.Fields(5)) Then '判断余额是否足够
MsgBox "卡内余额不足请充值后登陆", vbOKOnly + vbExclamation, "警告"
txtcard.Text = ""
Exit Sub
Else
txtSQL = "select * from student_Info where cardno = '" & txtcard.Text & "' " '没有上机,去student_info表中查找相关数据记录
<span style="white-space:pre"> </span>Set mrc = ExecuteSQL(txtSQL, Msgtext)
txtstyle.Text = Trim(mrc.Fields(14))
txtStudentNO.Text = Trim(mrc.Fields(1))
txtUserName.Text = Trim(mrc.Fields(2))
txtXiBie.Text = Trim(mrc.Fields(4))
txtsex.Text = Trim(mrc.Fields(3))
txtBalance.Text = Trim(mrc.Fields(7))
ad = Trim(mrc.Fields(9))
txtSQL = "insert into Online_Info values('" & txtcard.Text & "', '" & txtstyle.Text & "','" & txtStudentNO.Text & "','" & txtUserName.Text & "','" & txtXiBie.Text & "','" & txtsex.Text & "','" & Date & "','" & Time & "','" & Trim(Winsock1.LocalHostName) & "','" & Now & "','" & ad & "')"
Set mrc = ExecuteSQL(txtSQL, Msgtext)
'添加到Online_Info 表中
Labelsjtime.Visible = True
txtShangdate.Text = Date
txtShangTime.Text = Time
End If
Else
MsgBox "此卡正在上机", vbOKOnly + vbExclamation, "警告" '该卡正在上机,给出提示
End If
End If
End Sub
在Line_Info表中填入数
Private Sub Panduan()
Dim txtSQL2 As String
Dim MsgText2 As String
Dim txtSQL4 As String
Dim MsgText4 As String
Dim Object As ADODB.Recordset
Dim Object3 As ADODB.Recordset
txtSQL2 = "delete Online_Info where cardno = '" & txtcard.Text & "' "
Set Object = ExecuteSQL(txtSQL2, MsgText2)
txtSQL4 = "select * from Line_Info"
Set Object3 = ExecuteSQL(txtSQL4, MsgText4)
Object3.AddNew
Object3.Fields(1) = txtcard.Text
Object3.Fields(2) = txtStudentNO.Text
Object3.Fields(3) = txtUserName.Text
Object3.Fields(4) = txtXiBie.Text
Object3.Fields(5) = txtsex.Text
Object3.Fields(6) = txtShangdate.Text
Object3.Fields(7) = txtShangTime.Text
Object3.Fields(8) = txtOutdate.Text
Object3.Fields(9) = txtOuttime.Text
Object3.Fields(10) = txtConsumeMin.Text
Object3.Fields(11) = txtConsumeMoney.Text
Object3.Fields(12) = txtBalance.Text
Object3.Fields(13) = "正常下机"
Object3.Fields(14) = Trim(Winsock1.LocalHostName)
Object3.Fields(15) = "未结账"
Object3.Fields(16) = ad
Object3.Update
Object3.Close
MsgBox "下机成功,欢迎再次光临!", vbOKOnly + vbInformation, "欢迎再次光临"
Exit Sub
End Sub