机房收费系统之上下机
感觉上下机比结账要简单一些，可能因为自己敲得比结账要快的原因。
先说一下上机，需要用到student、line和online表：
（1）判断是否为空，是否存在或不在使用，余额是否充足，是否正在上机，如果上机则将上机信息显示出来。
（2）上机成功后，将相关信息显示出来。上机信息添加到online表中，为了信息的完整性，也要将相关信息添加到line表中。
代码如下：
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
Dim mrc2 As ADODB.Recordset
Dim mrc3 As ADODB.Recordset
Dim mrc4 As ADODB.Recordset
Dim leastmoney As Long
'使下机的文本框为空
txtOffdate.Text = ""
txtOfftime.Text = ""
txtConsumetime.Text = ""
txtConsumecash.Text = ""
'判断卡号是否为空
If Not testtxt(txtcardno.Text) Then
MsgBox "请输入卡号！", vbOKOnly + vbExclamation, "提示"
txtcardno.SetFocus
Exit Sub
End If
Set mrc1 = New ADODB.Recordset
txtSQL1 = "select * from student_Info where cardno = '" & txtcardno.Text & "' and status = '使用'"
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, "提示"
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 + vbExclamation, "提示"
txtcardno.Text = Trim(mrc2.Fields(0))
txtType.Text = Trim(mrc2.Fields(1))
txtSID.Text = Trim(mrc2.Fields(2))
txtName.Text = Trim(mrc2.Fields(3))
txtDept.Text = Trim(mrc2.Fields(4))
txtSex.Text = Trim(mrc2.Fields(5))
txtOndate.Text = Trim(mrc2.Fields(6))
txtOntime.Text = Trim(mrc2.Fields(7))
txtBalance.Text = Trim(mrc1!cash)
Exit Sub
Else '没有在上机，添加上机信息
txtcardno.Text = Trim(mrc1.Fields(0))
txtSID.Text = Trim(mrc1.Fields(1))
txtName.Text = Trim(mrc1.Fields(2))
txtSex.Text = Trim(mrc1.Fields(3))
txtDept.Text = Trim(mrc1.Fields(4))
txtOndate.Text = Date
txtOntime.Text = Time
txtBalance.Text = Trim(mrc1.Fields(7))
txtType.Text = Trim(mrc1!Type)
'将上机信息添加到online表中
Set mrc3 = New ADODB.Recordset
txtSQL3 = "select * from Online_Info where cardno= '" & Trim(txtcardno.Text) & "'"
Set mrc3 = ExecuteSQL(txtSQL3, MsgText3)
mrc3.AddNew
mrc3.Fields(0) = Trim(txtcardno.Text)
mrc3.Fields(1) = Trim(txtType.Text)
mrc3.Fields(2) = Trim(txtSID.Text)
mrc3.Fields(3) = Trim(txtName.Text)
mrc3.Fields(4) = Trim(txtDept.Text)
mrc3.Fields(5) = Trim(txtSex.Text)
mrc3.Fields(6) = Trim(txtOndate.Text)
mrc3.Fields(7) = Trim(txtOntime.Text)
mrc3.Fields(8) = Trim(Winsock1.LocalHostName)
mrc3.Update
'显示此时上机的人数
labOnpeople.Caption = mrc3.RecordCount
'信息放到line表中
txtSQL4 = "select * from line_Info "
Set mrc4 = ExecuteSQL(txtSQL4, MsgText4)
mrc4.AddNew
mrc4.Fields(1) = Trim(txtcardno.Text)
mrc4.Fields(2) = Trim(txtSID.Text)
mrc4.Fields(3) = Trim(txtName.Text)
mrc4.Fields(4) = Trim(txtDept.Text)
mrc4.Fields(5) = Trim(txtSex.Text)
mrc4.Fields(6) = Trim(txtOndate.Text)
mrc4.Fields(7) = Trim(txtOntime.Text)
mrc4!cash = Trim(txtBalance.Text)
mrc4!computer = Trim(Winsock1.LocalHostName)
mrc4.Update
End If
End If
End If
End Sub<span style="font-family: SimSun; background-color: rgb(255, 255, 255);"> </span>
下机，需要用到student、online、line、basicdata表 ：
（
1）卡号不能为空，卡号需正在上机。
（2）计算消费时间、计算消费金额。
（3）将信息更新到student、online、line表中。
代码如下：
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
Dim mrc2 As ADODB.Recordset
Dim mrc3 As ADODB.Recordset
Dim mrc4 As ADODB.Recordset
Dim leasttime As String
Dim OldCash As String
Dim NewCash As String
Dim StrType As String
Dim StartTime As String
Dim EndTime As String
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= '" & Trim(txtcardno.Text) & "'"
Set mrc1 = ExecuteSQL(txtSQL1, MsgText1)
If mrc1.EOF 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(1))
txtSID.Text = Trim(mrc2.Fields(2))
txtName.Text = Trim(mrc2.Fields(3))
txtDept.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))
EndTime = Format(Time, "hh:mm:ss")
txtConsumetime.Text = DateDiff("n", Trim(StartTime), Trim(EndTime)) '计算消费时间
'计算消费金额
StrType = Trim(mrc1.Fields(14)) '获得用户类型，判断用户单位价格
OldCash = Val(mrc1.Fields(7)) '获得用户余额
'在basicdate表中获取基本数据
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
'如果总时长少于至少上机时间，则消费为0
If Val(Trim(txtConsumetime.Text)) < leasttime Then
NewCash = OldCash
txtConsumecash.Text = "0.0"
Else
'如果小于60分钟且多于预备时间
If Val(Trim(txtConsumetime.Text)) < 60 And Val(Trim(txtConsumetime.Text)) > leasttime Then
NewCash = Val(OldCash) - Val(StrRate) * 1
consume = StrRate
Else
Inttime = Int(Val(txtConsumetime.Text) / 60)
NewCash = Val(OldCash) - StrRate * Inttime
consume = StrRate * Inttime
End If
txtConsumecash.Text = Val(consume) & ".0"
txtBalance.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 & "'"
Call ExecuteSQL(txtSQL2, MsgText2)
txtSQL2 = "select * from OnLine_Info "
Set mrc2 = ExecuteSQL(txtSQL2, MsgText2)
labOnpeople.Caption = mrc2.RecordCount '获取新的上机人数
'更新Line表
txtSQL4 = "select * from Line_Info where cardno= '" & txtcardno.Text & "'"
Set mrc4 = ExecuteSQL(txtSQL4, MsgText4)
mrc4.Fields(1) = Trim(txtcardno.Text)
mrc4.Fields(2) = Trim(txtSID.Text)
mrc4.Fields(3) = Trim(txtName.Text)
mrc4.Fields(4) = Trim(txtDept.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(txtConsumecash.Text)
mrc4.Fields(12) = Trim(NewCash)
mrc4.Fields(13) = "正常下机"
mrc4.Fields(14) = Trim(Winsock1.LocalHostName) '获取机器号
mrc4.Update
mrc4.Close
End If
End Sub 虽然相对来说上下机花费的时间不算多，但是这些代码页并不是全部自己独立完成的，比如获取机器号是通过看别人的博客完成的。但是就没有想着自己查如何获取机器号，这是自己欠缺的，通过自己独立的查一些东西应该收获的会更多。站在巨人的肩膀上并不是一昧的看别人比较全的博客，这样是少走了很多弯路，但是缺少成长了一些。我很多时候也会依赖别人，这样自己解决问题的能力得不到很好的锻炼。不知道自己这样的认识对不对，反正现在是这样认识的，希望自己可以得到一个很好的成长。