机房收费之上下机

    刚开始敲上下机时觉得还比较难，主要还是没有缕清思路，没有明白自己要干嘛，所以就会有些盲目，通过下面这个流程图可以很清晰地知道自己每一步要怎么做，写代码的时候就简单了许多，上下机重要的部分还是和所花费的
钱算清楚了。



Private Sub shangji_Click()

Dim txtsql As String, txtSQL1 As String, txtSQL3 As String
Dim Msgtext As String
Dim mrc As ADODB.Recordset
Dim rst As ADODB.Recordset
Dim mrcc As ADODB.Recordset

If txtcardno(0).Text = "" Then
'判断卡号是否为空
MsgBox "卡号不能为空", vbOKOnly + vbExclamation, "提示"
txtcardno(0).SetFocus
Exit Sub
Else
txtsql = "select * from student_info where cardno ='" & Trim(txtcardno(0).Text) & "'"
Set mrc = ExecuteSQL(txtsql, Msgtext)
txtSQL1 = "SELECT * from basicdata_info"
Set rst = ExecuteSQL(txtSQL1, Msgtext)
If mrc.EOF And mrc.BOF Then
'判断卡号是否注册
MsgBox "此卡号尚未注册！", vbOKOnly + vbExclamation, "提示"
txtcardno(0).SelStart = 0   '返回或设置选择文本的起始位置
txtcardno(0).SelLength = Len(txtcardno(0).Text)'选中的长度
txtcardno(0).SetFocus
Exit Sub
Else
If Trim(mrc.Fields(10)) = "不使用" Then

MsgBox "此卡已退，不能使用！", vbOKOnly + vbExclamation, "提示"
txtcardno(0).SelStart = 0   '返回或设置选择文本的起始位置
txtcardno(0).SelLength = Len(txtcardno(0).Text)'选中的长度
txtcardno(0).SetFocus
Exit Sub
Else
If mrc.Fields(7) < rst.Fields(5) Then
'判断余额是否充足
MsgBox "余额只有" & mrc.Fields(7) & ",少于最少金额，请先充值！", vbOKOnly, "警告!"
Exit Sub
Else
txtSQL3 = "select * from online_info where cardno='" & Trim(txtcardno(0).Text) & "'"
Set mrcc = ExecuteSQL(txtSQL3, Msgtext)

If Not (mrcc.EOF And mrcc.BOF) Then
'判断此卡号是否正在上机
MsgBox "此卡号正在上机", vbOKOnly, "提示"
txtID(1).Text = mrc.Fields(1)
txtdepartment(2).Text = mrc.Fields(4)
txttype(3).Text = mrc.Fields(14)
txtName(4).Text = mrc.Fields(2)
txtsex(5).Text = mrc.Fields(3)
txtsdate(0).Text = mrcc.Fields(6)
StartDate = txtsdate(0).Text
txtamount(2).Text = mrc.Fields(7)
txtstime(3).Text = mrcc.Fields(7)
StartTime = txtstime(3).Text
txtxdate(1).Text = ""
txtxtime(4).Text = ""
txtconsumetime(5).Text = ""
txtconsumepay(6).Text = ""

txtcardno(0).SelStart = 0   '返回或设置选择文本的起始位置
txtcardno(0).SelLength = Len(txtcardno(0).Text)'选中的长度
txtcardno(0).SetFocus
Exit Sub
Else
'显示卡号的相关信息
txtID(1).Text = mrc.Fields(1)
txtdepartment(2).Text = mrc.Fields(4)
txttype(3).Text = mrc.Fields(14)
txtName(4).Text = mrc.Fields(2)
txtsex(5).Text = mrc.Fields(3)
StartDate = Date
txtsdate(0).Text = StartDate
txtamount(2).Text = mrc.Fields(7)
StartTime = Time
txtstime(3).Text = StartTime
txtxdate(1).Text = ""
txtxtime(4).Text = ""
txtconsumetime(5).Text = ""
txtconsumepay(6).Text = ""
Label1.Caption = "上机成功"
'把信息录入到 online_info表中
mrcc.AddNew
mrcc.Fields(0) = txtcardno(0).Text
mrcc.Fields(1) = txttype(3).Text
mrcc.Fields(2) = txtID(1).Text
mrcc.Fields(3) = txtName(4).Text
mrcc.Fields(4) = txtdepartment(2).Text
mrcc.Fields(5) = txtsex(5).Text
mrcc.Fields(6) = txtsdate(0).Text
mrcc.Fields(7) = txtstime(3).Text
mrcc.Fields(8) = VBA.Environ("computername")
mrcc.Fields(9) = Now
mrcc.Update'更新数据库
mrcc.Close
End If
End If
End If
End If
End If

End Sub

</pre><pre name="code" class="vb">Private Sub xiaji_Click()
Dim CostDate As Long, CostTime As Long, cash As Long
Dim alltime As Single'上机时间
Dim consumemoney As Currency'上机费用
Dim Rate, tmpRate, unittime, leasttime, preparetime
Dim txtsql As String, txtSQL1 As String, txtSQL2 As String, txtSQL3 As String
Dim Msgtext As String
Dim mrc As ADODB.Recordset
Dim rst As ADODB.Recordset
Dim mrcc As ADODB.Recordset
Dim line As ADODB.Recordset

txtSQL1 = "select * from online_info where cardno='" & Trim(txtcardno(0).Text) & "'"
Set mrc = ExecuteSQL(txtSQL1, Msgtext) '从数据库中选择卡号等于输入的卡号
txtSQL2 = "select * from student_info"
Set mrcc = ExecuteSQL(txtSQL2, Msgtext)

If mrc.EOF And mrc.BOF Then
'判断卡号是否在上机
MsgBox "此卡号没有上机！", vbOKOnly, "提示" '如果没有在上机，提示
'信息为空
txtID(1).Text = ""'学号为空
txtdepartment(2).Text = ""
txttype(3).Text = ""
txtname(4).Text = ""
txtsex(5).Text = ""
txtsdate(0).Text = ""
txtamount(2).Text = ""
txtstime(3).Text = ""
txtxdate(1).Text = ""
txtxtime(4).Text = ""
txtconsumetime(5).Text = ""
txtconsumepay(6).Text = ""
txtcardno(0).SetFocus
Else
'显示一些信息
'下机日期和时间
EndDate = Date
EndTime = Time
'显示此卡号上机时的信息
txtID(1).Text = mrc.Fields(2)
txtdepartment(2).Text = mrc.Fields(4)
txttype(3).Text = mrc.Fields(1)
txtname(4).Text = mrc.Fields(3)
txtsex(5).Text = mrc.Fields(5)
StartDate = mrc.Fields(6)
txtsdate(0).Text = StartDate
txtamount(2).Text = mrcc.Fields(7)
StartTime = mrc.Fields(7)
txtstime(3).Text = StartTime

'计算消费时间
CostDate = DateDiff("n", StartDate, EndDate) '日期差返回分钟数
CostTime = DateDiff("n", StartTime, EndTime)'时间差返回分钟数
alltime = CostDate + CostTime '使用时间为多少分钟

txtsql = "select * from basicdata_info"
Set rst = ExecuteSQL(txtsql, Msgtext)

'把数据库的值赋给各个字段
Rate = rst.Fields(0)
tmpRate = rst.Fields(1)
unittime = rst.Fields(2)
leasttime = rst.Fields(3)
preparetime = rst.Fields(4)

'收费情况
If alltime <= preparetime Then
consumemoney = 0
Else
If alltime <= leasttime Then
consumemoney = Val(Rate / 2)
Else
If txttype(3).Text = "固定用户" And alltime <= unittime Then
consumemoney = Val(Rate)

ElseIf txttype(3).Text = "固定用户" And alltime > unittime Then
consumemoney = Val(Rate * Int(alltime / 60 + 1))

ElseIf txttype(3).Text = "临时用户" And alltime <= unittime Then
consumemoney = Val(tmpRate)
ElseIf txttype(3).Text = "临时用户" And alltime < unittime Then
consumemoney = Val(tmpRate * Int(alltime / 60 + 1))
End If
End If
End If

txtxdate(1).Text = EndDate
txtxtime(4).Text = EndTime
txtconsumetime(5).Text = alltime
txtconsumepay(6).Text = consumemoney
cash = txtamount(2).Text - consumemoney
txtamount(2).Text = cash '更新金额
'数据库student_info中金额也更新

mrcc.Fields(7) = txtamount(2).Text
mrcc.Update
mrcc.Close
'删除online_info中记录
mrc.Delete
mrc.Update
'往line_info中添加记录
txtSQL3 = "select * from line_info"
Set line = ExecuteSQL(txtSQL3, Msgtext)
line.AddNew
line.Fields(1) = txtcardno(0).Text
line.Fields(2) = txtID(1).Text
line.Fields(3) = txtname(4).Text
line.Fields(4) = txtdepartment(2).Text
line.Fields(5) = txtsex(5).Text
line.Fields(6) = StartDate
line.Fields(7) = StartTime
line.Fields(8) = EndDate
line.Fields(9) = EndTime
line.Fields(10) = alltime
line.Fields(11) = consumemoney
line.Fields(12) = cash
line.Fields(13) = "正常下机"
line.Fields(14) = VBA.Environ("computername")
line.Update
line.Close
MsgBox "下机成功！", vbOKCancel, "提示"
'清空信息
txtID(1).Text = ""
txtdepartment(2).Text = ""
txttype(3).Text = ""
txtname(4).Text = ""
txtsex(5).Text = ""
StartDate = ""
txtsdate(0).Text = ""
txtamount(2).Text = ""
txtstime(3).Text = ""
txtxdate(1).Text = ""
txtxtime(4).Text = ""
txtconsumetime(5).Text = ""
txtconsumepay(6).Text = ""
txttime.Text = ""
txtnumber.Text = ""
txtcardno(0).SetFocus
txtcardno(0).Text = ""
Label1.Caption = ""
End If
End Sub