哈哈,机房收费系统基本上敲完了,现在分享一下上下机的知识吧!!!
刚开始敲上下机的时候,思维有点混乱,其实弄明白表与表之间的关系,心里有”卡号“这一条主线,就会清晰好多......
首先是上机:
<span style="font-family:KaiTi_GB2312;font-size:18px;"><strong><span style="font-family:KaiTi_GB2312;font-size:18px;"><strong>Private Sub shangji_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
Dim mrc2 As ADODB.Recordset
Dim mrc3 As ADODB.Recordset
Dim mrc4 As ADODB.Recordset
Dim leastmoney As Long
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, "提示"
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) = Trim(txtondate.Text)
mrc3.Fields(7) = Trim(txtontime.Text)
mrc3.Fields(8) = Trim(Winsock1.LocalHostName)
mrc3.Update
'显示此时上机的人数
Label13.Caption = mrc3.RecordCount
mrc3.Close
mrc2.Close
End If
End If
End If
End Sub
</strong></span></strong></span>
其次是下机:
<span style="font-family:KaiTi_GB2312;font-size:18px;"><strong><span style="font-family:KaiTi_GB2312;font-size:18px;"><strong>Private Sub xiaji_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
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='" & 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(1))
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 = Int(Val(txtconsumetime.Text) / 60)
NewCash = Val(OldCash) - StrRate * Inttime
consume = StrRate * Inttime
End If
txtconsume.Text = Val(consume) & ".0"
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 & "'"
Call executesql(txtsql2, msgtext2)
txtsql2 = "select * from OnLine_Info "
Set mrc2 = executesql(txtsql2, msgtext2)
Label13.Caption = mrc2.RecordCount '获取新的上机人数
'更新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
End Sub
</strong></span></strong></span>
我的代码很多,有木有?理解着来就会发现其实也挺简单的。在代码中有一句获取机器号的代码
这个也很简单,首先添加控件:
工程|部件|Microsoft Winsock Control 6.0
添加后是这个按钮:,漂亮吧,和timer控件相似,只有这么大,small baby ,嘿嘿......
然后添加一句代码就OK了!
mrc4.Fields(14) = Trim(Winsock1.LocalHostName)
上下机就这样被我“无情”的解决掉了,嘿嘿,神清气爽,有木有?小伙伴们,可要加油啦!!!