首页 > 资讯 > 其他综合 > 正文

第一次机房收费系统

16-08-25 来源：[db:作者]

收藏我要投稿

前言：

原以为上机很困难，自己没有办法完成的，但是当自己真正地静下心来去点师姐给的系统，对应着数据库一点点地看，才发现原来上机并没有想象中的那么困难！

流程图：

首先开始的时候思路一定要清楚，中间细节的部分可以先不做考虑，等大致的框架出来之后再将细节的部分添加进去！就像盖房子一样，大致框架就相当于房子的墙，细节部分就相当于房子里面的各种装饰，缺一不可！

知识点：

1.使用的卡显示已经注销

                    '数据集中有记录，但是该卡已经停用
                    txtSQL = "select * from student_info where cardno='" & txtcardno.Text & "'and status='不使用'"
                    Set mrc5 = ExecuteSQL(txtSQL, MsgText)
                    If mrc5.EOF = False Then
                        MsgBox "该卡已经注销，请重新输入！", 48, "提示"
                        txtcardno.Text = ""
                        txtcardno.SetFocus

2.余额问题

                txtSQL = "select * from student_info where cardno='" & txtcardno.Text & "'and status='使用'"
                Set mrc3 = ExecuteSQL(txtSQL, MsgText)

                    '判断余额是否小于最小金额，若小于，需要充值后再继续上机，强制下机，此时最好弹出充值界面
                    '此时判断用户类型
                    txtSQL = "select * from basicdata_info"
                    Set mrc4 = ExecuteSQL(txtSQL, MsgText)
                    If mrc3.Fields(7) < mrc4.Fields(5) Then
                        MsgBox "余额小于最小限制金额，请充值后再上机！", 48, "提示"
                        '弹出充值窗口
                        frmrecharge.Show
                        SetParent frmrecharge.hWnd, Picture1.hWnd

3.不能重复上机

            txtSQL = "select * from online_info where cardno='" & txtcardno.Text & "'"
            Set mrc2 = ExecuteSQL(txtSQL, MsgText)
            If mrc2.EOF = False Then
                MsgBox "该卡正在上机，不能重复上机！", 48, "提示"

4.获取计算机名

在模块中定义计算机名，然后在代码框中调用

'API函数声明计算机名
Public Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long

'调用API函数获取计算机名

Public Function GetThisComputerName() As String
    Dim sBuffer As String
    Dim lSize As Long
    
    sBuffer = Space$(255)
    lSize = Len(sBuffer)
    GetComputerName sBuffer, lSize
    
    If lSize > 0 Then
        GetThisComputerName = Left$(sBuffer, lSize)
    End If
End Function

在代码框中调用：

mrc.Fields(8) = GetThisComputerName     '将计算机名同步到数据库的相应表格中

5.将数据同步到表中

上机涉及到四个表：online_info line_info student_info basicdata_info

    '上机时将上机卡的数据同步至online_info表中
    Set mrc = New ADODB.Recordset
    txtSQL = "select * from online_info"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    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) = Trim(txtOnLinedate.Text)
    mrc.Fields(7) = Trim(txtOnLinetime.Text)
    mrc.Fields(8) = GetThisComputerName     '将计算机名同步到数据库的相应表格中
    mrc.Fields(9) = Now
    Label16.Caption = mrc.RecordCount + 1  '显示上机人数
    mrc.Update
    mrc.Close
    
     '上机时将上机卡的数据同步到line_info表中
     Set mrc6 = New ADODB.Recordset
     txtSQL = "select * from line_info"
     Set mrc6 = ExecuteSQL(txtSQL, MsgText)
     mrc6.AddNew
     mrc6.Fields(1) = Trim(txtcardno.Text)
     mrc6.Fields(2) = Trim(txtstudentno.Text)
     mrc6.Fields(3) = Trim(txtstudentname.Text)
     mrc6.Fields(4) = Trim(txtdepartment.Text)
     mrc6.Fields(5) = Trim(txtsex.Text)
     mrc6.Fields(6) = Trim(txtOnLinedate.Text)
     mrc6.Fields(7) = Trim(txtOnLinetime.Text)
     mrc6.Fields(12) = Trim(txtcash.Text)
     mrc6.Fields(13) = "正常上机"
     mrc6.Fields(14) = GetThisComputerName
     mrc6.Update
     mrc6.Close
     MsgBox "上机完成！", 48, "提示"

代码展示：

Private Sub cmdOnLine_Click()
    '判断卡号是否为空，如果为空，提醒输入；
    '若不为空，判断是否注册过，如果注册了就继续往下执行；
    '没有注册包括：数据集中没有这个卡号；数据集中有这个卡号，但是该卡已经停用！
    If txtcardno.Text = "" Then
        MsgBox "卡号不能为空，请输入！", 48, "警告"
        txtcardno.SetFocus
    Else
        txtSQL = "select * from student_info where cardno='" & txtcardno.Text & "'"
        Set mrc1 = ExecuteSQL(txtSQL, MsgText)
        '数据集中没有记录的情况
        If mrc1.EOF = True Then
            MsgBox "该卡没有注册，请重新输入！", 48, "提示"
            txtcardno.Text = ""
            txtcardno.SetFocus
'            mrc1.Update
'            mrc1.Close
        Else
        
            '判断是否上机了，一个卡不能重复上机；
            '如果已经上机，显示上机，若没有上机，进行正常上机
            '正常上机后将文本框中的数据添加到online_info表中
            
            
            '判断是否上机
            txtSQL = "select * from online_info where cardno='" & txtcardno.Text & "'"
            Set mrc2 = ExecuteSQL(txtSQL, MsgText)
            If mrc2.EOF = False Then
                MsgBox "该卡正在上机，不能重复上机！", 48, "提示"
            Else
                '正常使用的卡
                txtSQL = "select * from student_info where cardno='" & txtcardno.Text & "'and status='使用'"
                Set mrc3 = ExecuteSQL(txtSQL, MsgText)
                If mrc3.EOF = False Then
                    '将数据库总中的数据显示在文本框中
                    txtstudentno.Text = Trim(mrc3.Fields(1))
                    txtdepartment.Text = Trim(mrc3.Fields(4))
                    txttype.Text = Trim(mrc3.Fields(14))
                    txtstudentname.Text = Trim(mrc3.Fields(2))
                    txtsex.Text = Trim(mrc3.Fields(3))
                    Label24.Visible = True
                    txtOnLinedate.Text = Date
                    txtOnLinetime.Text = Time
                    txtcash.Text = Trim(mrc3.Fields(7))
    '                mrc3.Update
    '                mrc3.Close
    
                    '判断余额是否小于最小金额，若小于，需要充值后再继续上机，强制下机，此时最好弹出充值界面
                    '此时判断用户类型
                    txtSQL = "select * from basicdata_info"
                    Set mrc4 = ExecuteSQL(txtSQL, MsgText)
                    If mrc3.Fields(7) < mrc4.Fields(5) Then
                        MsgBox "余额小于最小限制金额，请充值后再上机！", 48, "提示"
                        '弹出充值窗口
                        frmrecharge.Show
                        SetParent frmrecharge.hWnd, Picture1.hWnd
'                        Exit Sub
                    End If
                Else
                    '数据集中有记录，但是该卡已经停用
                    txtSQL = "select * from student_info where cardno='" & txtcardno.Text & "'and status='不使用'"
                    Set mrc5 = ExecuteSQL(txtSQL, MsgText)
                    If mrc5.EOF = False Then
                        MsgBox "该卡已经注销，请重新输入！", 48, "提示"
                        txtcardno.Text = ""
                        txtcardno.SetFocus
    '                    mrc2.Update
    '                    mrc2.Close
                    End If
                End If
            End If
        End If
    End If
    
    '上机时将上机卡的数据同步至online_info表中
    Set mrc = New ADODB.Recordset
    txtSQL = "select * from online_info"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    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) = Trim(txtOnLinedate.Text)
    mrc.Fields(7) = Trim(txtOnLinetime.Text)
    mrc.Fields(8) = GetThisComputerName     '将计算机名同步到数据库的相应表格中
    mrc.Fields(9) = Now
    Label16.Caption = mrc.RecordCount + 1  '显示上机人数
    mrc.Update
    mrc.Close
    
     '上机时将上机卡的数据同步到line_info表中
     Set mrc6 = New ADODB.Recordset
     txtSQL = "select * from line_info"
     Set mrc6 = ExecuteSQL(txtSQL, MsgText)
     mrc6.AddNew
     mrc6.Fields(1) = Trim(txtcardno.Text)
     mrc6.Fields(2) = Trim(txtstudentno.Text)
     mrc6.Fields(3) = Trim(txtstudentname.Text)
     mrc6.Fields(4) = Trim(txtdepartment.Text)
     mrc6.Fields(5) = Trim(txtsex.Text)
     mrc6.Fields(6) = Trim(txtOnLinedate.Text)
     mrc6.Fields(7) = Trim(txtOnLinetime.Text)
     mrc6.Fields(12) = Trim(txtcash.Text)
     mrc6.Fields(13) = "正常上机"
     mrc6.Fields(14) = GetThisComputerName
     mrc6.Update
     mrc6.Close
     MsgBox "上机完成！", 48, "提示"
End Sub

未完待续O(∩_∩)O~

点击复制链接与好友分享!回本站首页