frmstopuseandloss.frm

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

End If
End Sub
Private Sub cmdStopUse_Click()
If cmdStopUse.Caption = "停 用" Then
    If Judge = True Then
        If MsgBox("确实要停用吗?", vbYesNo + vbQuestion, "机房管理") = vbYes Then
            RsCardholder.Fields!State = "停用"
            RsCardholder.Update
            SaveStopUse
            Call AddLog("L35", "StopUse")      '记入操作日志
        End If
    End If
    ElseIf cmdStopUse.Caption = "挂 失" Then
    If JudgeLoss = True Then
        If MsgBox("确实要挂失吗?", vbYesNo + vbQuestion, "机房管理") = vbYes Then
            rsCardholderLoss.Fields!State = "挂失"
            rsCardholderLoss.Update
            SaveLoss
            Call AddLog("L32", "Loss")         '记入操作日志
        End If
    End If
End If
End Sub

Private Sub SSTStopUseAndLoss_Click(PreviousTab As Integer)
If SSTStopUseAndLoss.Tab = 0 Then
    cmdStopUse.Caption = "停 用"
    cmdChangeCard.Visible = False
    ElseIf SSTStopUseAndLoss.Tab = 1 Then
        cmdStopUse.Caption = "挂 失"
        cmdChangeCard.Visible = True
End If
End Sub

Private Sub txtC_ID_Change()
txtC_ID.Text = Left(txtC_ID.Text, 1) & UCase(Mid(txtC_ID.Text, 2, 1)) & Right(txtC_ID.Text, 8)

Set RsCardholder = New Recordset
RsCardholder.Open "select CH_Name,state from TbCardholder where CH_ID like '" & txtC_ID.Text & "'", Modmain.conn, 3, 2
    If RsCardholder.RecordCount <> 0 Then
        lblCH_NameList.Caption = RsCardholder.Fields!CH_Name
        If RsCardholder.Fields!State = "正常" Then
            cmdRecall.Enabled = False
            cmdStopUse.Enabled = True
            lblDate.Caption = "停用时间"
            cboDate.Visible = True
            lblDay.Visible = True
            lblList.Visible = False

            ElseIf RsCardholder.Fields!State = "停用" Then
                cmdStopUse.Enabled = False
                cmdRecall.Enabled = True
                Set rsStopUseRecall = New Recordset
                rsStopUseRecall.Open "select * from TbStopUse where C_ID like '" & txtC_ID.Text & "'", Modmain.conn, 3, 2
                lblDate.Caption = "停用日期"
                cboDate.Visible = False
                lblDay.Visible = False
                lblList.Visible = True
                lblList.Caption = rsStopUseRecall.Fields!stop_Date
                lblUse_DateList.Caption = Date
                ElseIf RsCardholder.Fields!State = "挂失" Then
                      MsgBox "该卡已挂失！", vbOKOnly + vbExclamation, "机房管理"
                    ElseIf RsCardholder.Fields!State = "上机" Then
                        MsgBox "该卡正在上机！", vbOKOnly + vbExclamation, "机房管理"
        End If
    Else
        MsgBox "您输入的持卡人ID不存在，请确认后重新输入！", vbOKOnly + vbExclamation, "机房管理"
        '''txtC_ID.Text = ""
    End If
End Sub

Private Sub txtC_ID_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Or Len(txtC_ID.Text) = 10 Then
txtC_ID.Text = Left(txtC_ID.Text, 1) & UCase(Mid(txtC_ID.Text, 2, 1)) & Right(txtC_ID.Text, 8)

Set RsCardholder = New Recordset
RsCardholder.Open "select CH_Name,state from TbCardholder where CH_ID like '" & txtC_ID.Text & "'", Modmain.conn, 3, 2
    If RsCardholder.RecordCount <> 0 Then
        lblCH_NameList.Caption = RsCardholder.Fields!CH_Name
        If RsCardholder.Fields!State = "正常" Then
            cmdRecall.Enabled = False
            cmdStopUse.Enabled = True
            lblDate.Caption = "停用时间"
            cboDate.Visible = True
            lblDay.Visible = True
            lblList.Visible = False

            ElseIf RsCardholder.Fields!State = "停用" Then
                cmdStopUse.Enabled = False
                cmdRecall.Enabled = True
                Set rsStopUseRecall = New Recordset
                rsStopUseRecall.Open "select * from TbStopUse where C_ID like '" & txtC_ID.Text & "'", Modmain.conn, 3, 2
                lblDate.Caption = "停用日期"
                cboDate.Visible = False
                lblDay.Visible = False
                lblList.Visible = True
                lblList.Caption = rsStopUseRecall.Fields!stop_Date
                lblUse_DateList.Caption = Date
                ElseIf RsCardholder.Fields!State = "挂失" Then
                      MsgBox "该卡以挂失！", vbOKOnly + vbExclamation, "机房管理"
                    ElseIf RsCardholder.Fields!State = "上机" Then
                        MsgBox "该卡正在上机！", vbOKOnly + vbExclamation, "机房管理"
        End If
    Else
        MsgBox "您输入的持卡人ID不存在，请确认后重新输入！", vbOKOnly + vbExclamation, "机房管理"
        ''txtC_ID.Text = ""
    End If
End If
End Sub

Private Sub SaveStopUse()
Set rsStopUse = New Recordset
rsStopUse.Open "select * from TbStopUse", Modmain.conn, 3, 2
rsStopUse.AddNew
With rsStopUse
.Fields!C_ID = txtC_ID.Text
.Fields!stop_Date = Date
.Fields!Use_Date = Date + cboDate.Text
.Fields!U_ID = frmLoad.StrU_ID
If txtMemo.Text <> "" Then
    .Fields!Memo = txtMemo.Text
End If
.Update
End With
MsgBox "保存成功", vbOKOnly + vbInformation, "机房管理"    '保存完毕并提醒
''txtC_ID.Text = ""
lblCH_NameList.Caption = ""
cboDate.ListIndex = -1
lblUse_DateList.Caption = ""
txtMemo.Text = ""
End Sub
Private Function Judge() As Boolean
If Trim(txtC_ID) = "" Then
    MsgBox "持卡人ID不能为空", vbOKOnly + vbExclamation, "机房管理"
    txtC_ID.SetFocus
    ElseIf Trim(cboDate.Text) = "" Then
        MsgBox "停用时间不能为空", vbOKOnly + vbExclamation, "机房管理"
        cboDate.SetFocus
            Else
                Judge = True
End If
End Function


Private Function JudgeRecall() As Boolean
If Trim(txtC_ID) = "" Then
    MsgBox "持卡人ID不能为空", vbOKOnly + vbExclamation, "机房管理"
    txtC_ID.SetFocus
    Else
        JudgeRecall = True
End If
End Function

Private Sub SaveStopUseRecall()
RsCardholder.Fields!State = "正常"
RsCardholder.Update
rsStopUseRecall.MoveLast
rsStopUseRecall.Fields!Use_Date = Date
rsStopUseRecall.Update
MsgBox "保存成功", vbOKOnly + vbInformation, "机房管理"    '保存完毕并提醒
lblCH_NameList.Caption = ""
lblList.Caption = ""
lblUse_DateList.Caption = ""
txtMemo.Text = ""
End Sub

Private Sub txtC_IDLoss_Change()
txtC_IDLoss.Text = Left(txtC_IDLoss.Text, 1) & UCase(Mid(txtC_IDLoss.Text, 2, 1)) & Right(txtC_IDLoss.Text, 8)

Set rsCardholderLoss = New Recordset
rsCardholderLoss.Open "select CH_Name,state from TbCardholder where CH_ID like '" & txtC_IDLoss.Text & "'", Modmain.conn, 3, 2
    If rsCardholderLoss.RecordCount <> 0 Then
        lblCH_NameLossList.Caption = rsCardholderLoss.Fields!CH_Name
        If rsCardholderLoss.Fields!State = "正常" Then
           cmdRecall.Enabled = False
            cmdStopUse.Enabled = True
            cmdChangeCard.Enabled = True
            lblLoss_DateList.Caption = Date
            ElseIf rsCardholderLoss.Fields!State = "挂失" Then
                cmdRecall.Enabled = True
                cmdStopUse.Enabled = False
                cmdChangeCard.Enabled = False
                Set rsLossRecall = New Recordset
                rsLossRecall.Open "select * from Tbloss where C_ID like '" & txtC_IDLoss.Text & "'", Modmain.conn, 3, 2
                lblLoss_DateList.Caption = rsLossRecall.Fields!Loss_Date
                ElseIf rsCardholderLoss.Fields!State = "停用" Then
                    MsgBox "该卡已停用！", vbOKOnly + vbExclamation, "机房管理"
                    ElseIf rsCardholderLoss.Fields!State = "上机" Then
                        MsgBox "该卡正在上机！", vbOKOnly + vbExclamation, "机房管理"
        End If
    Else
        MsgBox "您输入的持卡人ID不存在，请确认后重新输入！", vbOKOnly + vbExclamation, "机房管理"
        'txtC_IDLoss.Text = ""
    End If
End Sub

Private Sub txtC_IDLoss_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Or Len(txtC_IDLoss.Text) = 10 Then
txtC_IDLoss.Text = Left(txtC_IDLoss.Text, 1) & UCase(Mid(txtC_IDLoss.Text, 2, 1)) & Right(txtC_IDLoss.Text, 8)

Set rsCardholderLoss = New Recordset
rsCardholderLoss.Open "select CH_Name,state from TbCardholder where CH_ID like '" & txtC_IDLoss.Text & "'", Modmain.conn, 3, 2
    If rsCardholderLoss.RecordCount <> 0 Then
        lblCH_NameLossList.Caption = rsCardholderLoss.Fields!CH_Name
        If rsCardholderLoss.Fields!State = "正常" Then
           cmdRecall.Enabled = False
            cmdStopUse.Enabled = True
            cmdChangeCard.Enabled = True
            lblLoss_DateList.Caption = Date
            ElseIf rsCardholderLoss.Fields!State = "挂失" Then
                cmdRecall.Enabled = True
                cmdStopUse.Enabled = False
                cmdChangeCard.Enabled = False
                Set rsLossRecall = New Recordset
                rsLossRecall.Open "select * from Tbloss where C_ID like '" & txtC_IDLoss.Text & "'", Modmain.conn, 3, 2
                lblLoss_DateList.Caption = rsLossRecall.Fields!Loss_Date
                ElseIf rsCardholderLoss.Fields!State = "停用" Then
                    MsgBox "该卡已停用！", vbOKOnly + vbExclamation, "机房管理"
                    ElseIf rsCardholderLoss.Fields!State = "上机" Then
                        MsgBox "该卡正在上机！", vbOKOnly + vbExclamation, "机房管理"
        End If
    Else
        MsgBox "您输入的持卡人ID不存在，请确认后重新输入！", vbOKOnly + vbExclamation, "机房管理"
        'txtC_IDLoss.Text = ""
    End If
End If
End Sub

Private Function JudgeLoss() As Boolean
If Trim(txtC_IDLoss) = "" Then
    MsgBox "持卡人ID不能为空", vbOKOnly + vbExclamation, "机房管理"
    txtC_IDLoss.SetFocus
    Else
        JudgeLoss = True
End If
End Function

Private Sub SaveLoss()
Set rsloss = New Recordset
rsloss.Open "select * from TbLoss", Modmain.conn, 3, 2
rsloss.AddNew
With rsloss
.Fields!C_ID = txtC_IDLoss.Text
.Fields!Loss_Date = Date
.Fields!U_ID = frmLoad.StrU_ID
.Fields!Use_Date = Null
If txtMemoLoss.Text <> "" Then
    .Fields!Memo = txtMemoLoss.Text
End If
.Update
End With
MsgBox "保存成功", vbOKOnly + vbInformation, "机房管理"    '保存完毕并提醒
'txtC_IDLoss.Text = ""
lblCH_NameLossList.Caption = ""
lblLoss_DateList.Caption = ""
txtMemoLoss.Text = ""
End Sub

Private Sub SaveLossRecall()
rsCardholderLoss.Fields!State = "正常"
rsCardholderLoss.Update
rsLossRecall.MoveLast
rsLossRecall.Fields!Use_Date = Date
rsLossRecall.Update
MsgBox "保存成功", vbOKOnly + vbInformation, "机房管理"    '保存完毕并提醒
'txtC_IDLoss.Text = ""
lblCH_NameLossList.Caption = ""
lblLoss_DateList.Caption = ""
txtMemoLoss.Text = ""

End Sub

Private Sub ChangNo()
rsCardholderChange.Fields!State = "正常"
rsCardholderChange.Fields!ch_id = StrNewNo
rsCardholderChange.Update

        Set rsSaving = New Recordset
        rsSaving.Open "select * from TbSaving  where C_ID like '" & txtC_IDLoss.Text & "' ", Modmain.conn, 3, 2
        If rsSaving.RecordCount <> 0 Then              'TbSaving新号换旧号
            While Not rsSaving.EOF
            rsSaving.Fields!C_ID = StrNewNo
            rsSaving.Update
            rsSaving.MoveNext
            Wend
        End If
        Set rsStopUseFind = New Recordset
        rsStopUseFind.Open "select * from TbStopUse where C_ID like '" & txtC_IDLoss.Text & "' ", Modmain.conn, 3, 2
        If rsStopUseFind.RecordCount <> 0 Then              'TbStopUse新号换旧号
            While Not rsStopUseFind.EOF
            rsStopUseFind.Fields!C_ID = StrNewNo
            rsStopUseFind.Update
            rsStopUseFind.MoveNext
            Wend
        End If
        Set rsLossFind = New Recordset
        rsLossFind.Open "select * from TbLoss  where C_ID like '" & txtC_IDLoss.Text & "' ", Modmain.conn, 3, 2
        If rsLossFind.RecordCount <> 0 Then              'TbLoss 新号换旧号
            While Not rsLossFind.EOF
            rsLossFind.Fields!C_ID = StrNewNo
            rsLossFind.Update
            rsLossFind.MoveNext
            Wend
        End If
        Set rsShangJi = New Recordset
        rsShangJi.Open "select * from TbShangji  where C_ID like '" & txtC_IDLoss.Text & "' ", Modmain.conn, 3, 2
        If rsShangJi.RecordCount <> 0 Then              ' TbShangji 新号换旧号
            While Not rsShangJi.EOF
            rsShangJi.Fields!C_ID = StrNewNo
            rsShangJi.Update
            rsShangJi.MoveNext
            Wend
        End If
'txtC_IDLoss.Text = ""
lblCH_NameLossList.Caption = ""
lblLoss_DateList.Caption = ""
txtMemoLoss.Text = ""
End Sub

Private Sub LinShi()
Set RsCreateNo = New Recordset
RsCreateNo.Open "select * from TbCreateNo where Abbreviation='" & strtype & "'", Modmain.conn, 3, 2
j = CInt(CInt(RsCreateNo.Fields!maxno) + 1)
Dim str As String
str = CStr("00000000" & j)
StrNewNo = strtype & Right(str, 8)
MsgBox "您的新号是：" & StrNewNo, vbDefaultButton1, "机房管理"
RsCreateNo.Fields!maxno = j
RsCreateNo.Update
End Sub

Private Sub Student()
Set rsClass = New Recordset
Dim aa As Integer
aa = Right(txtC_IDLoss.Text, 3)
rsClass.Open "select * from TBClass where left(C_ID,5) like '" & Mid(txtC_IDLoss.Text, 3, 5) & "' and  CInt(StartNo)<=" & aa & " and CInt(EndNo) >=" & aa & "", Modmain.conn, 3, 2
Dim IntMin As Integer
Dim IntMax As Integer
IntMin = rsClass.Fields!StartNo
IntMax = rsClass.Fields!EndNo

Set rsCardholderChange = New Recordset
rsCardholderChange.Open "select max(right(CH_ID,3)) as n from TBCardholder  where left(CH_ID,7) like '" & Left(txtC_IDLoss.Text, 7) & "' and  right(CH_ID,3)> " & IntMin & " and right(CH_ID,3)<" & IntMax & "", Modmain.conn, 3, 2
StrNewNo = Left(txtC_IDLoss.Text, 7) & Right("000" & (CInt(rsCardholderChange.Fields!n) + 1), 3)
MsgBox "您的新号是：" & StrNewNo, vbDefaultButton1, "机房管理"
End Sub

Private Sub XueYuan()
Set RsCreateNo = New Recordset
RsCreateNo.Open "select * from TbCreateNo where Abbreviation='" & strtype & "'", Modmain.conn, 3, 2
j = CInt(CInt(RsCreateNo.Fields!maxno) + 1)
Dim str As String
str = Mid(txtC_IDLoss.Text, 3, 1) & Right("00000000" & j, 7)
StrNewNo = strtype & str
MsgBox "您的新号是：" & StrNewNo, vbDefaultButton1, "机房管理"
RsCreateNo.Fields!maxno = j
RsCreateNo.Update
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''将用户停用、挂失卡的信息记入操作日志                            ''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub AddLog(LogType As String, txt As String)
Dim strEvents As String
Dim strTemp As String
strTemp = "'"
Set rsOperateLog = New Recordset
rsOperateLog.Open "select * from tbOperateLog", Modmain.conn, 3, 2
Set rsLog = New Recordset
rsLog.Open "select * from tblog where L_ID='" & LogType & "'", Modmain.conn, 3, 2
strEvents = rsLog.Fields!Events

rsOperateLog.AddNew
    rsOperateLog.Fields!U_ID = frmLoad.StrU_ID
    rsOperateLog.Fields!Time = Time
    rsOperateLog.Fields!Date = Date
    rsOperateLog.Fields!Events = strEvents
    If txt = "StopUse" Then
        rsOperateLog.Fields!Description = strTemp & txtC_ID.Text & strTemp & strEvents
    ElseIf txt = "Loss" Then
        rsOperateLog.Fields!Description = strTemp & txtC_IDLoss.Text & strTemp & strEvents
    Else
        rsOperateLog.Fields!Description = strEvents
    End If
rsOperateLog.Update
End Sub