问题七 上下机

首先画个图帮自己理清思路，输入卡号时需要判断的4部曲。

1.上机



记录乱七八糟上机代码：

Private Sub Command1_Click() '上机
Dim txtSQL1 As String
Dim txtSQL2 As String
Dim txtSQL3 As String
Dim txtSQL4 As String
Dim txtsql5 As String

Dim msgtext1 As String
Dim msgtext2 As String
Dim msgtext3 As String
Dim msgtext4 As String
Dim msgtext5 As String

Dim mrc1 As ADODB.Recordset '连接student表
Dim mrc2 As ADODB.Recordset '连接online表
Dim mrc3 As ADODB.Recordset '连接Line表
Dim mrc4 As ADODB.Recordset '连接BasicData表
Dim mrc5 As ADODB.Recordset '连接Recharge_Info表

Dim leastmoney As Integer

txtoffdate.Text = ""
txtofftime.Text = ""
txtconsume.Text = ""
txtconsumetime.Text = ""

'判断卡号是否为空
If Testtxt(txtCardNo.Text) = False Then
MsgBox "请输入卡号！", vbOKOnly + vbExclamation, "警告"
txtCardNo.SetFocus
Exit Sub
End If
Set mrc1 = New ADODB.Recordset
txtSQL1 = "select * from student_Info where cardno='" & txtCardNo.Text & "'"
Set mrc1 = ExecuteSQL(txtSQL1, msgtext1)

'判断该卡是否存在
If mrc1.EOF And mrc1.BOF Then
MsgBox "该卡号未注册！", vbOKOnly + vbExclamation, "提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
Else

'判断余额是否充足
Set mrc4 = New ADODB.Recordset
txtSQL4 = "select * from BasicData_Info"
Set mrc4 = ExecuteSQL(txtSQL4, msgtext4)
leastmoney = mrc4.Fields(5)
If mrc1.Fields(7) < leastmoney Then
MsgBox "余额只有" & mrc1.Fields(7) & ",少于最少金额，请充值后再上机！", vbOKOnly, "提示"
frmRecharge.Show
Exit Sub
mrc4.Close
Else

'判断卡号是否正在上机
Set mrc2 = New ADODB.Recordset
txtSQL2 = "select * from online_Info where cardno='" & txtCardNo.Text & "'"
Set mrc2 = ExecuteSQL(txtSQL2, msgtext2)

If Not (mrc2.EOF And mrc2.BOF) Then
MsgBox "该卡正在上机！", vbOKOnly, "提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
Else

txtCardNo.Text = Trim(mrc1.Fields(0))
txtstudentNo.Text = Trim(mrc1.Fields(1))
txtstudentname.Text = Trim(mrc1.Fields(2))
txttype.Text = Trim(mrc1.Fields(14))
txtsex.Text = Trim(mrc1.Fields(3))
txtdepartment.Text = Trim(mrc1.Fields(4))
txtondate.Text = Date
txtontime.Text = Time
txtcash.Text = Trim(mrc1.Fields(7))

'将上机的信息添加到onLine_Info表中
Set mrc3 = New ADODB.Recordset
txtSQL3 = "select * from onLine_Info"
Set mrc3 = ExecuteSQL(txtSQL3, msgtext3)
mrc3.AddNew
mrc3.Fields(0) = Trim(txtCardNo.Text)
mrc3.Fields(1) = Trim(txttype.Text)
mrc3.Fields(2) = Trim(txtstudentNo.Text)
mrc3.Fields(3) = Trim(txtstudentname.Text)
mrc3.Fields(4) = Trim(txtdepartment.Text)
mrc3.Fields(5) = Trim(txtsex.Text)
mrc3.Fields(6) = Date
mrc3.Fields(7) = Time
mrc3.Fields(8) = Trim(Winsock1.LocalHostName)
mrc3.Fields(9) = Date
mrc3.Update

'显示此时上机的人数
Label8.Caption = mrc3.RecordCount

mrc3.Close
mrc2.Close
End If
End If
End If

txtsql5 = "select * from ReCharge_Info where cardno='" & txtCardNo.Text & "'"
Set mrc5 = ExecuteSQL(txtsql5, msgtext5)

End Sub

2.下机
    谈到下机，里面涉及到计算消费时间及消费金额，自己的金额往往很大，其实消费金额=单价*消费时间，消费时间没问题，问题那肯定就是出现在单价这里，单价为为2类，一类是固定用户，另一个是临时用户，因为固定用户与临时用户所设定的价格不一样，理清这个就没问题了，在其中还用到了一个Round 函数。

Round 函数：指的是四舍五入函数，实际上这个函数采用的四舍六入五留双，如：1.25留一位，则1.2=Round（1.25）；1.35留一位，则1.4=Round（1.35），基进偶不进。

DateDiff 函数 ：计算消费时间用到的。

记录一下乱七八糟下机代码

Private Sub Command2_Click() '下机
Dim txtSQL1 As String
Dim txtSQL2 As String
Dim txtSQL3 As String
Dim txtSQL4 As String

Dim msgtext1 As String
Dim msgtext2 As String
Dim msgtext3 As String
Dim msgtext4 As String

Dim mrc1 As ADODB.Recordset 'Student
Dim mrc2 As ADODB.Recordset 'noline
Dim mrc3 As ADODB.Recordset 'basicdata
Dim mrc4 As ADODB.Recordset 'line

Dim leasttime As Integer
Dim oldcash As Integer
Dim newcash As Integer
Dim strtype As String
Dim starttime As Date
Dim endtime As Date
Dim inttime As Integer
Dim strrate As Integer
Dim consume As Integer

'判断卡号是否为空
If Testtxt(txtCardNo.Text) = False Then
MsgBox "请输入卡号！", vbOKOnly + vbExclamation, "提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
End If

'判断该卡是否存在
Set mrc1 = New ADODB.Recordset
txtSQL1 = "select * from student_Info where cardno ='" & txtCardNo.Text & "'"
Set mrc1 = ExecuteSQL(txtSQL1, msgtext1)
If mrc1.EOF And mrc1.BOF Then
MsgBox "该卡号未注册！", vbOKOnly + vbExclamation, "提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
Else

'判断该卡号是否上机
Set mrc2 = New ADODB.Recordset
txtSQL2 = "select * from Online_Info where cardno = '" & txtCardNo.Text & "'"
Set mrc2 = ExecuteSQL(txtSQL2, msgtext2)
If mrc2.EOF And mrc2.BOF Then
MsgBox "该卡号没有上机！", vbOKOnly + vbExclamation, "提示"
txtCardNo.Text = ""
txtCardNo.SetFocus
Exit Sub
Else
txtCardNo.Text = Trim(mrc2.Fields(0))
txttype.Text = Trim(mrc2.Fields(2))
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 = Date
txtofftime.Text = Time

'计算消费时间
starttime = Format(mrc2.Fields(7), "hh:mm:ss")
endtime = 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))

Select Case strtype
Case "固定用户"
strrate = Val(Trim(mrc3.Fields(0))) '每小时费用,单价
Case "临时用户"
strrate = Val(Trim(mrc3.Fields(1)))
End Select

'消费时间<至少上机时间
If Val(Trim(txtconsumetime.Text)) < leasttime Then
newcash = oldcash
txtconsume.Text = "0.0"
Else
'消费时间<>至少上机时间
' If Val(Trim(txtconsumetime.Text)) < 60 And Val(Trim(txtconsumetime.Text)) > leasttime Then
' newcash = Val(oldcash) - Val(strrate) * 1
' consume = strrate
' Else
inttime = (Val(txtconsumetime.Text) Mod 60) '消费时间=消费时间/60分钟
consume = Round((Val(strrate) * inttime) / 60, 2) + 1 '消费金额=单价*消费时间
' newcash = Round(Val(oldcash) - Val(strrate) * inttime / 60, 2) '金额=原来金额-消费金额
newcash = Val(oldcash) - consume '金额=原来金额-消费金额
'
' End If
txtconsume.Text = Val(consume)
txtcash.Text = Val(newcash)
End If
End If

'更新student表
txtSQL1 = "update student_Info set cash='" & newcash & "' where cardno='" & txtCardNo.Text & "'"
Call ExecuteSQL(txtSQL1, msgtext1)

'更新Online表
txtSQL2 = "delete Online_Info where cardno='" & txtCardNo.Text & "'"
Set mrc2 = ExecuteSQL(txtSQL2, msgtext2)
' mrc2.Delete
txtSQL2 = "select * from Online_info"
Set mrc2 = ExecuteSQL(txtSQL2, msgtext2)

'更新Line表
txtSQL4 = "select * from Line_Info"
Set mrc4 = ExecuteSQL(txtSQL4, msgtext4)
mrc4.Fields(1) = Trim(txtCardNo.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(newcash)
mrc4.Fields(13) = "正常下机"
mrc4.Fields(14) = Trim(Winsock1.LocalHostName) '获取机器号
mrc4.Update
mrc4.Close
End If

【总结】
千万千万不要心急，也不能拖，耐心很重要，自己仍需努力哈。。。