第一次机房收费系统——无尽

最新推荐文章于 2020-01-04 16:52:09 发布

世代庄少主

最新推荐文章于 2020-01-04 16:52:09 发布

阅读量541

点赞数

分类专栏： ●VB与数据库学习 ——【第一次机房收费系统】

本文链接：https://blog.csdn.net/fjt123068/article/details/52572795

版权

——【第一次机房收费系统】同时被 2 个专栏收录

5 篇文章 0 订阅

订阅专栏

●VB与数据库学习

2 篇文章 0 订阅

订阅专栏

这是我的第一次机房收费系统，最近对上下机功能进行了学习。实现了，与大分享。

在这里，我将上机分为七个模块。按照如下的顺序只需要定义四个变量。既节省了内存，又便于修改。

<span style="font-size:18px;"><strong>Dim mrc As New ADODB.Recordset   '在一个库里，mrc可以重复使用。同时节省内存。
Dim strsql As String  '这里最省内存
Dim mrcBasicData As New ADODB.Recordset
Dim mrcline As New ADODB.Recordset</strong></span>

<span style="font-size:18px;"><strong>Private Sub cmdMachineOn_Click()    '上机

'模块一：判断卡号是否为空，判断卡号是否为数字
If Trim(txtcardno.Text = "") Then
MsgBox "请输入卡号！", vbOKOnly + vbExclamation, "提示"
txtcardno.SetFocus
Exit Sub
Else
        If Not IsNumeric(Trim(txtcardno.Text)) Then
        MsgBox "卡号必须输入数字！", vbOKOnly + vbExclamation, "提示"
        txtcardno.Text = ""
        txtcardno.SetFocus
        Exit Sub
        End If
End If

'模块二：判断卡号是否注册，是否已经退卡。这里先查student_Info，mrc为以后方便用。
strsql = "select * from student_Info where cardno= '" & Trim(txtcardno.Text) & "'"
Set mrc = ExecuteSQL(strsql, "")

If mrc.BOF And mrc.EOF Then
MsgBox "该卡号未注册，请先注册信息！", vbOKOnly + vbExclamation, "提示"
txtcardno.Text = ""
txtcardno.SetFocus
Exit Sub
Else
        If Trim(mrc.Fields(10)) = "不使用" Then
        MsgBox "该卡已经退卡", vbOKCancel + vbInformation, "提示"
        txtcardno.Text = ""
        txtcardno.SetFocus
        Exit Sub
        End If
End If

'模块三：查BasicData_Info，判断是余额小于最小金额。
strsql = "select * from BasicData_Info"
Set mrcBasicData = ExecuteSQL(strsql, "")

If Val(mrc.Fields(7)) < Val(mrcBasicData.Fields(5)) Then '这里mrc.Fields(7)用的很巧妙
MsgBox "余额不足，请充值后上机！", vbOKOnly + vbExclamation, "提示"
txtcardno.Text = ""
txtcardno.SetFocus
End If

'模块四：查OnLine_Info，看该卡是否在上机
strsql = "select * from OnLine_Info where cardno= '" & Trim(txtcardno.Text) & "'"
Set mrc = ExecuteSQL(strsql, "")

If mrc.EOF = False Then
MsgBox "该卡正在上机，不能重复上机！"
txtcardno.Text = mrc.Fields(0)
txttype.Text = mrc.Fields(1)
txtstudentNo.Text = mrc.Fields(2)
txtstudentName.Text = mrc.Fields(3)
txtdepartment.Text = mrc.Fields(4)
txtsex.Text = mrc.Fields(5)
txtMachineOnDate.Text = mrc.Fields(6)
txtMachineOnTime.Text = mrc.Fields(7)
Exit Sub
End If

'模块五：显示该卡号信息
strsql = "select * from student_Info where cardno= '" & Trim(txtcardno.Text) & "'"
Set mrc = ExecuteSQL(strsql, "")

If mrc.EOF = False Then
txtstudentNo.Text = Trim(mrc.Fields(1))
txtstudentName.Text = Trim(mrc.Fields(2))
txtsex.Text = mrc.Fields(3)
txtdepartment.Text = mrc.Fields(4)
txttype.Text = mrc.Fields(14)
txtMachineOnDate.Text = Date
txtMachineOnTime.Text = Time
End If

'模块六：更新line_Info数据
strsql = "select * from line_Info where cardno= '" & Trim(txtcardno.Text) & "'"
Set mrcline = ExecuteSQL(strsql, "")

mrcline.AddNew
mrcline.Fields(1) = Trim(txtcardno.Text)
mrcline.Fields(2) = Trim(txtstudentNo.Text)
mrcline.Fields(3) = Trim(txtstudentName.Text)
mrcline.Fields(4) = Trim(txtdepartment.Text)
mrcline.Fields(5) = Trim(txtsex.Text)
mrcline.Fields(6) = Trim(txtMachineOnDate.Text)
mrcline.Fields(7) = Trim(txtMachineOnTime.Text)
mrcline.Fields(12) = Trim(mrc.Fields(7))
mrcline.Fields(13) = "正常上机"
mrcline.Fields(14) = Trim(Environ("computername"))
mrcline.Update

'模块七：更新OnLine_Info数据
strsql = "select * from OnLine_Info"
Set mrc = ExecuteSQL(strsql, "")
mrc.AddNew
mrc.Fields(0) = Trim(txtcardno.Text)
mrc.Fields(1) = Trim(txttype.Text)
mrc.Fields(2) = Trim(txtstudentNo.Text)
mrc.Fields(3) = Trim(txtstudentName.Text)
mrc.Fields(4) = Trim(txtdepartment.Text)
mrc.Fields(5) = Trim(txtsex.Text)
mrc.Fields(6) = Date
mrc.Fields(7) = Time
mrc.Fields(8) = Trim(Environ("computername"))
mrc.Update

If mrc.EOF = True Then
  txtCurrentNumber.Text = 0
Else
txtCurrentNumber.Text = mrc.RecordCount
End If


End Sub

Private Sub cmdMachineUp_Click()   '下机

Dim intLineTime As Integer '用于存储实际在线时间
Dim intconsume As Single
Dim curConsume As Single '用于存储真正花费钱的时间
Dim curBalance As Single '用于存储用户的余额
Dim fixedunit As Single '用于存储单位金额
Dim temunit As Single '用于存储单位金额
Dim a As Integer
Dim remaincash As Single

'模块一：判断卡号是否为空，判断卡号是否为数字
If Trim(txtcardno.Text = "") Then
MsgBox "请输入卡号！", vbOKOnly + vbExclamation, "提示"
txtcardno.SetFocus
Exit Sub
Else
        If Not IsNumeric(Trim(txtcardno.Text)) Then
        MsgBox "卡号必须输入数字！", vbOKOnly + vbExclamation, "提示"
        txtcardno.Text = ""
        txtcardno.SetFocus
        Exit Sub
        End If
End If


'模块二：判断卡号是否注册，是否已经退卡。这里先查student_Info，mrc为以后方便用。
strsql = "select * from student_Info where cardno= '" & Trim(txtcardno.Text) & "'"
Set mrc = ExecuteSQL(strsql, "")

If mrc.BOF And mrc.EOF Then
MsgBox "该卡号未注册，请先注册信息！", vbOKOnly + vbExclamation, "提示"
txtcardno.Text = ""
txtcardno.SetFocus
Exit Sub
Else
        If Trim(mrc.Fields(10)) = "不使用" Then
            MsgBox "该卡已经退卡", vbOKCancel + vbInformation, "提示"
            txtcardno.Text = ""
            txtcardno.SetFocus
            Exit Sub
        End If
End If

'模块八：判断改卡号是否在上机，没有上机不能退卡
strsql = "select * from OnLine_Info where cardno= '" & Trim(txtcardno.Text) & "'"
Set mrc = ExecuteSQL(strsql, "")

If mrc.EOF = True Then
MsgBox "该卡没有上机，不能进行下机处理", vbOKOnly + vbExclamation, "警告"
txtcardno.Text = ""
txtcardno.SetFocus
End If
intLineTime = (Date - DateValue(mrc!onDate)) * 1440 + (Hour(Time) - Hour(TimeValue(mrc!OnTime))) * 60 + (Minute(Time) - Minute(TimeValue(mrc!OnTime))) '时间单位为分钟



strsql = "select * from student_Info where cardno= '" & Trim(txtcardno.Text) & "'"
Set mrc = ExecuteSQL(strsql, "")




'模块九：获得基本表的数据
strsql = "select * from BasicData_Info"
Set mrcBasicData = ExecuteSQL(strsql, "")
mrcBasicData.MoveLast
'单位时间的费用 （把固定用户，临时用户单位时间的费用分别赋值给费用）
fixedunit = Val(mrcBasicData.Fields(0)) '把固定用户的金额赋值给变量
temunit = Val(mrcBasicData.Fields(1)) '把临时用户的金额赋值给变量
'判断在线时间是否小于准备时间，若小于则 消费金额=0
If intLineTime <= Val(Trim(mrcBasicData.Fields(4))) Then
txtConsumptionAmount.Text = "0"
Else
'判断在线时间是否小于最低消费时间，若小于则为0
     If intLineTime < Val(Trim(mrcBasicData.Fields(3))) Then
     txtConsumptionAmount.Text = "0"
     End If
End If

 '在线时间大于单位时间，就按有几个单位时间算，分为固定用户和临时用户
If intLineTime >= Val(Trim(mrcBasicData!leasttime)) And intLineTime And Trim(mrc.Fields(14)) = "固定用户" Then
a = Int(intLineTime / Val(Trim(mrcBasicData!unittime)))
                If a = intLineTime / Trim(mrcBasicData!unittime) Then
                    curConsume = a
                Else
                    curConsume = a + 1
                End If
txtConsumptionAmount.Text = Val(curConsume) * Val(fixedunit)
Else
      If intLineTime >= Val(Trim(mrcBasicData!leasttime)) And intLineTime And Trim(mrc.Fields(14)) = "临时用户" Then
      a = Int(intLineTime / Val(Trim(mrcBasicData!unittime)))
                    If a = intLineTime / Trim(mrcBasicData!unittime) Then
                        curConsume = a
                    Else
                        curConsume = a + 1
                    End If
 
     txtConsumptionAmount.Text = Val(curConsume) * Val(temunit)
     End If
End If


'模块十：更新学生表
strsql = "select * from student_Info where cardno= '" & Trim(txtcardno.Text) & "'"
Set mrc = ExecuteSQL(strsql, "")
remaincash = mrc!cash - Val(txtConsumptionAmount.Text)

    mrc.Fields(7) = remaincash
    mrc.Update
    mrc.Close
    






'模块十二：下机显示，删除在线表的信息
strsql = "select * from OnLine_Info where cardno= '" & Trim(txtcardno.Text) & "'"
Set mrc = ExecuteSQL(strsql, "")

txtMachineUpDate.Text = Date
txtMachineUpTime.Text = Time
txttype = Trim(mrc.Fields(1))
txtstudentNo = Trim(mrc.Fields(2))
txtstudentName = Trim(mrc.Fields(3))
txtdepartment = Trim(mrc.Fields(4))
txtsex = Trim(mrc.Fields(5))
txtMachineOnDate = Trim(mrc.Fields(6))
txtMachineOnTime = Trim(mrc.Fields(7))
txtDissipate.Text = intLineTime
txtcash.Text = remaincash

'模块十一：更新上机记录表

strsql = "select * from line_Info where cardno= '" & Trim(txtcardno.Text) & "'"
Set mrcline = ExecuteSQL(strsql, "")
mrcline.Fields(8) = Trim(txtMachineUpDate.Text)
mrcline.Fields(9) = Trim(txtMachineUpTime.Text)
mrcline.Fields(10) = Trim(txtDissipate.Text)
mrcline.Fields(11) = Trim(txtConsumptionAmount.Text)
mrcline.Fields(12) = Trim(txtcash.Text)
mrcline.Fields(13) = Trim("正常下机")
mrcline.Update

MsgBox "下机成功，欢迎下次再来", vbOKOnly + vbExclamation, "警告"



'删除在线表的信息
mrc.Delete
mrc.Update
txtCurrentNumber.Text = Str(Int(txtCurrentNumber.Text) - 1)


End Sub</strong></span>