frmmain.frm

本论文以西电基础教学实验中心学生上机管理系统为背景

If frmLoad.BlInstitute = True Then
    frmInstitute.Show 1
End If
End Sub

Private Sub MnuLOOKPerson_Click()
FrmListPerson.Show 1
End Sub
Private Sub MnuOperateLog_Click()
If frmLoad.blOperateLog = True Then
    frmOperateLog.Show 1
End If
End Sub
Private Sub MnuOperator_Click()
If frmLoad.BlOperator = True Then
    frmUser.Show 1
End If
End Sub

Private Sub MnuPrepay_Click()
If frmLoad.BlPrepay = True Then
    frmPrepay.Show 1
End If
End Sub
Private Sub MnuPrinter_Click()
If frmLoad.BlPrinter = True Then
On Error GoTo aa
    CdgPrint.ShowPrinter
aa:                       '没有对错误进行处理
End If
End Sub

Private Sub MnuReworkPsd_Click()
If frmLoad.StrU_Name <> "" Then
    frmChangePwd.Show 1
End If
End Sub

Private Sub MnuSaveStatistic_Click()
If frmLoad.BlSaveStatistic = True Then
    frmSaveStatistic.Show 1
End If
End Sub

Private Sub MnuSaving_Click()
If frmLoad.BlSaving = True Then
    frmSave.Show 1
End If
End Sub

Private Sub MnuShangjiStatistic_Click()
If frmLoad.BlShangjiStatistic = True Then
    frmShangjiStatistic.Show 1
End If
End Sub

Private Sub MnuStart_Click()
BlOK = False
frmLoad.Show 1
End Sub

Private Sub MnuStopUse_Click()
If frmLoad.BlStopUse = True Then
    frmStopUseAndLoss.Show 1
End If
End Sub

Private Sub MnuTable_Click()
If frmLoad.BlTable = True Then
    frmGraphLook.Show 1
End If
End Sub

Private Sub TbaMain_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
    Case "Operator"
        MnuOperator_Click
    Case "Institute"
        MnuInstitute_Click
    Case "Cardholder"
        MnuCardholder_Click
    Case "Computer"
        MnuComputer_Click
    Case "CurrSchedule"
        MnuCurrSchedule_Click
    Case "StopUse"
        MnuStopUse_Click
    Case "Prepay"
        MnuPrepay_Click
    Case "Saving"
        MnuSaving_Click
    Case "ExitCard"
        MnuExitCard_Click
    Case "Table"
        MnuTable_Click
    Case "Graph"
        MnuGraph_Click
    Case "SaveStatistic"
        MnuSaveStatistic_Click      '充值统计
    Case "EductionStatistic"
        MnuEductionStatistic_Click
    Case "ShangjiStatistic"
        MnuShangjiStatistic_Click
    Case "About"
        frmAbout.Show 1
    Case "Printer"
        MnuPrinter_Click
    Case "Exit"
        Unload Me
    Case "ReworkPsd"
        MnuReworkPsd_Click
    Case "Database"
         MnuDatabase_Click
    Case "OperateLog"
        MnuOperateLog_Click
    Case "Help"
        MnuHelpFrom_Click
End Select
End Sub
Private Sub timeBak_Timer()                '每一分钟自动备份一次全部信息
Dim fso As New FileSystemObject, File1 As File, file2 As File
  Set File1 = fso.GetFile(App.Path & "\dbmanage.mdb")
  File1.Copy ("d:\机房备份\dbmanage.mdb")
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''每分钟调用一次timer事件,对上机超过6分钟的记费一次0.15元         ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Tmcount_Timer()
Set rsShangJiTempCount = New Recordset
rsShangJiTempCount.Open "select * from TbShangJiTemp", Modmain.conn, 3, 2
While Not rsShangJiTempCount.EOF
srtid = rsShangJiTempCount.Fields!C_ID
If Hour(Time()) - Hour(rsShangJiTempCount.Fields!Start_Time) = 0 Then             '在同一小时
    If Minute(Time()) - Minute(rsShangJiTempCount.Fields!Start_Time) >= 6 Then
        CountMoney                                                      '记费函数
    End If
ElseIf Hour(Time()) - Hour(rsShangJiTempCount.Fields!Start_Time) > 0 Then          '在不同小时
    If Minute(Time()) + 60 - Minute(rsShangJiTempCount.Fields!Start_Time) >= 6 Then
       CountMoney                                 '记费函数
    End If
End If
rsShangJiTempCount.MoveNext
Wend
End Sub

Private Sub txtCH_ID_Change()
    txtCH_ID.Text = Left(txtCH_ID.Text, 1) & UCase(Mid(txtCH_ID.Text, 2, 1)) & Right(txtCH_ID.Text, 8)
    Set RsCardholder = New Recordset
    RsCardholder.Open "select * from TbCardholder where CH_ID like '" & txtCH_ID & "'", Modmain.conn, 3, 2
    
    If RsCardholder.RecordCount = 0 Then                     '判断输入的卡号是否存在
        lblInformation.Caption = "该卡号不存在"
        'txtCH_ID.Text = ""
        n = 0
        Timer1.Enabled = True
        Exit Sub
    End If
    
    If RsCardholder.Fields!State = "挂失" Then           '判断该卡是否已挂失
        lblInformation.Caption = "该卡已挂失"
        'txtCH_ID.Text = ""
        n = 0
        Timer1.Enabled = True
        Exit Sub
    End If
    
    
    If RsCardholder.Fields!State = "停用" Then             '判断该卡是否已停用
        lblInformation.Caption = "该卡已停用"
        'txtCH_ID.Text = ""
        n = 0
        Timer1.Enabled = True
        Exit Sub
    End If
    Dim aa As String
    
    aa = "正常"
    Set rsComputer = New Recordset
    rsComputer.Open "select * from TbComputer where State = '" & aa & "' ", Modmain.conn, 3, 2
    If rsComputer.RecordCount = 0 Then                      '机房无使用机器
        lblInformation.Caption = "机房无可使用机器"
        n = 0
        Timer1.Enabled = True
        Exit Sub
    End If
    
    If RsCardholder.Fields!State = "正常" Then              '该卡正常，执行上机操作
        ListInformation
        If RsCardholder.Fields!Money < 5 Then               '判断该卡的金额是否小于5元
            lblInformation.Caption = "您的余额不足请充值!"
            n = 0
            Timer1.Enabled = True
            Exit Sub
        End If
                                                 '显示相关信息
        If Time > #7:45:00 AM# And Time() < #8:30:00 AM# Or Time > #1:45:00 PM# And Time() < #2:30:00 PM# Or Time > #5:45:00 PM# And Time() < #6:30:00 PM# Then           '课前15分钟、课后30分钟，教学上机学生不收费
          If Left(txtCH_ID.Text, 2) = "0B" Or Left(txtCH_ID.Text, 2) = "0Z" Or Left(txtCH_ID.Text, 2) = "0Y" Then
            If Time > #7:45:00 AM# And Time() < #8:30:00 AM# Then       '上午
                Set rsMorning = New Recordset
                rsMorning.Open "select * from TbCurrSchedule where Date =date() and Morning like '" & lblC_IDList.Caption & "'", Modmain.conn, 3, 2
                If rsMorning.RecordCount = 0 Then
                    AddShangJiTemp
                Else
                    lblShjiTypeList.Caption = "教学上机"
                End If
            End If
            If Time > #1:45:00 PM# And Time() < #2:30:00 PM# Then       '下午
                Set rsAfternoon = New Recordset
                rsAfternoon.Open "select * from TbCurrSchedule where Date =date() and Afternoon like '" & lblC_IDList.Caption & "'", Modmain.conn, 3, 2
                If rsAfternoon.RecordCount = 0 Then
                    AddShangJiTemp
                Else
                    lblShjiTypeList.Caption = "教学上机"
                End If
            End If
            If Time > #5:45:00 PM# And Time() < #6:30:00 PM# Then        '晚上
                Set rsNight = New Recordset
                rsNight.Open "select * from TbCurrSchedule where Date =date() and Night like '" & lblC_IDList.Caption & "'", Modmain.conn, 3, 2
                If rsNight.RecordCount = 0 Then
                    AddShangJiTemp
                Else
                    lblShjiTypeList.Caption = "教学上机"
                End If
            End If
          Else
            AddShangJiTemp
          End If
        Else
            AddShangJiTemp
        End If
        AllotC_ID                                             '分配机号,改变计算机状态为‘使用’
        AddShangJi                                             '在TbShangJi保存卡号、机号、上机时间等信息
        AddCardholderTemp                                    '将详细信息装入TbCardholderTemp以供查询,并改变持卡人状态为上机
        AddlvwPerson                                         '将详细信息装入lvwPerson控件
        Exit Sub
    End If
    
    If RsCardholder.Fields!State = "上机" Then              '该卡正常，执行下机操作
        Set rsShangJiTempExit = New Recordset
        rsShangJiTempExit.Open "select * from TbShangJiTemp where C_ID like '" & txtCH_ID.Text & "'", Modmain.conn, 3, 2
         ListExitInformation                                            '显示下机的相关信息
        If rsShangJiTempExit.RecordCount = 0 Then                       '不收费
            NoCount
        Else                                                            '收费
            Cout
        End If
        lblInformation.Caption = "下机成功"
        n = 0
        Timer1.Enabled = True

    End If

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''输入卡号后,执行一系列操作                                       ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub txtCH_ID_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Or Len(txtCH_ID.Text) = 10 Then
    txtCH_ID.Text = Left(txtCH_ID.Text, 1) & UCase(Mid(txtCH_ID.Text, 2, 1)) & Right(txtCH_ID.Text, 8)
    Set RsCardholder = New Recordset
    RsCardholder.Open "select * from TbCardholder where CH_ID like '" & txtCH_ID & "'", Modmain.conn, 3, 2
    
    If RsCardholder.RecordCount = 0 Then                     '判断输入的卡号是否存在
        lblInformation.Caption = "该卡号不存在"
         n = 0
        Timer1.Enabled = True
        Exit Sub
    End If
    
    If RsCardholder.Fields!State = "挂失" Then           '判断该卡是否已挂失
        lblInformation.Caption = "该卡已挂失"
        n = 0
        Timer1.Enabled = True
        Exit Sub
    End If
    
    
    If RsCardholder.Fields!State = "停用" Then             '判断该卡是否已停用
        lblInformation.Caption = "该卡已停用"
        n = 0
        Timer1.Enabled = True
        Exit Sub
    End If
    Dim aa As String
    
    aa = "正常"
    Set rsComputer = New Recordset
    rsComputer.Open "select * from TbComputer where State = '" & aa & "' ", Modmain.conn, 3, 2
    If rsComputer.RecordCount = 0 Then                      '机房无使用机器
        lblInformation.Caption = "机房无可使用机器"
        n = 0
        Timer1.Enabled = True
        Exit Sub
    End If
    
    If RsCardholder.Fields!State = "正常" Then              '该卡正常，执行上机操作
        ListInformation
        If RsCardholder.Fields!Money < 5 Then               '判断该卡的金额是否小于5元
            lblInformation.Caption = "您的余额不足请充值!"
            n = 0
            Timer1.Enabled = True
            Exit Sub
        End If
                                                 '显示相关信息
        If Time > #7:45:00 AM# And Time() < #8:30:00 AM# Or Time > #1:45:00 PM# And Time() < #2:30:00 PM# Or Time > #5:45:00 PM# And Time() < #6:30:00 PM# Then           '课前15分钟、课后30分钟，教学上机学生不收费
          If Left(txtCH_ID.Text, 2) = "0B" Or Left(txtCH_ID.Text, 2) = "0Z" Or Left(txtCH_ID.Text, 2) = "0Y" Then
            If Time > #7:45:00 AM# And Time() < #8:30:00 AM# Then       '上午
                Set rsMorning = New Recordset
                rsMorning.Open "select * from TbCurrSchedule where Date =date() and Morning like '" & lblC_IDList.Caption & "'", Modmain.conn, 3, 2
                If rsMorning.RecordCount = 0 Then
                    AddShangJiTemp
                Else
                    lblShjiTypeList.Caption = "教学上机"
                End If
            End If
            If Time > #1:45:00 PM# And Time() < #2:30:00 PM# Then       '下午
                Set rsAfternoon = New Recordset
                rsAfternoon.Open "select * from TbCurrSchedule where Date =date() and Afternoon like '" & lblC_IDList.Caption & "'", Modmain.conn, 3, 2
                If rsAfternoon.RecordCount = 0 Then
                    AddShangJiTemp
                Else
                    lblShjiTypeList.Caption = "教学上机"
                End If
            End If
            If Time > #5:45:00 PM# And Time() < #6:30:00 PM# Then        '晚上
                Set rsNight = New Recordset
                rsNight.Open "select * from TbCurrSchedule where Date =date() and Night like '" & lblC_IDList.Caption & "'", Modmain.conn, 3, 2
                If rsNight.RecordCount = 0 Then
                    AddShangJiTemp
                Else
                    lblShjiTypeList.Caption = "教学上机"
                End If
            End If
          Else
            AddShangJiTemp
          End If
        Else
            AddShangJiTemp
        End If
        AllotC_ID                                             '分配机号,改变计算机状态为‘使用’
        AddShangJi                                             '在TbShangJi保存卡号、机号、上机时间等信息
        AddCardholderTemp                                    '将详细信息装入TbCardholderTemp以供查询,并改变持卡人状态为上机
        AddlvwPerson                                         '将详细信息装入lvwPerson控件
        Exit Sub
    End If
    
    If RsCardholder.Fields!State = "上机" Then              '该卡正常，执行下机操作
        Set rsShangJiTempExit = New Recordset
        rsShangJiTempExit.Open "select * from TbShangJiTemp where C_ID like '" & txtCH_ID.Text & "'", Modmain.conn, 3, 2
         ListExitInformation                                            '显示下机的相关信息
        If rsShangJiTempExit.RecordCount = 0 Then                       '不收费
            NoCount
        Else                                                            '收费
            Cout
        End If
        lblInformation.Caption = "下机成功"
        n = 0
        Timer1.Enabled = True
    End If
End If
End Sub
Private Sub ListInformation()
If Left(txtCH_ID.Text, 2) = "0B" Or Left(txtCH_ID.Text, 2) = "0Z" Or Left(txtCH_ID.Text, 2) = "0Y" Then     '给学生信息赋值
    lblNoList.Caption = Right(txtCH_ID.Text, 8)               '给学号赋值
    
    Set rsSort = New Recordset
    rsSort.Open "select * from TbSort where ST