frmissue.frm

学生选课系统

                    vbInformation, "注意"
            txtBookId.Text = ""
            txtMemId.SetFocus
        Exit Sub
        End If

        '获取当前书本所属主题
        Dim adoprimaryrs1 As Recordset
        Set adoprimaryrs1 = New Recordset
        adoprimaryrs1.Open "select Subject from Titles where " & _
                            "titleid ='" & lbltitle.Caption & "'", _
                            db, adOpenStatic, adLockOptimistic
        subj = adoprimaryrs1.Fields(0)
        '获取此主题的最大出借天数
        Dim adoprimaryrs2 As Recordset
        Set adoprimaryrs2 = New Recordset
        adoprimaryrs2.Open "select IssueDays,Noofbooks,FineCharge," & _
                            "ReserveCharge,Issuedays from Subjects " & _
                            "where Subject='" & subj & "'", _
                            db, adOpenStatic, adLockOptimistic
        noofdaysx = adoprimaryrs2.Fields(4)
    
        Dim adoprimaryrs3 As Recordset
        Set adoprimaryrs3 = New Recordset
        adoprimaryrs3.Open "select titleid from books where " & _
                            "memberid='" & Trim(txtMemId.Text) & "'", _
                            db, adOpenStatic, adLockOptimistic
    
        Dim adoprimaryrs4 As Recordset
        Set adoprimaryrs4 = New Recordset
        '获取用户借阅当前主题书籍的册书
        While Not adoprimaryrs3.EOF
            adoprimaryrs4.Open "select Subject from Titles where " & _
                                "titleid ='" & adoprimaryrs3.Fields(0) & _
                                "'", db, adOpenStatic, adLockOptimistic
            If subj = adoprimaryrs4.Fields(0) Then
                Counter = Counter + 1
            End If
            adoprimaryrs3.MoveNext
            adoprimaryrs4.Close
        Wend
        If Counter >= adoprimaryrs2.Fields(1) Then
            MsgBox "用户已在当前主题中借阅图书已超出最大允许值。", _
                    vbInformation, "注意"
            txtBookId.Text = ""
            txtMemId.SetFocus
            Exit Sub
        End If
        '可以借书
        '更新所借书本的信息
        Dim adoprimaryrs5 As Recordset
        Set adoprimaryrs5 = New Recordset
        adoprimaryrs5.Open "select memberid,BOOKID,ISIN,returndate " & _
                            "from books ", db, adOpenStatic, adLockOptimistic
        adoprimaryrs5.Find ("BookId='" & txtBookId.Text & "'")
        adoprimaryrs5.Fields(0) = Trim(txtMemId)
        adoprimaryrs5.Fields(2) = False
        '计算归还日期
        adoprimaryrs5.Fields(3) = DateAdd("d", noofdaysx, Date)
        adoprimaryrs5.Update
        '计算归还日期
        lblreturn.Caption = DateAdd("d", noofdaysx, Date)
        
        '更新会员的借阅信息
        Dim adoprimaryrs6 As Recordset
        Set adoprimaryrs6 = New Recordset
        adoprimaryrs6.Open "select MemberId,BooksInHand,FineBal " & _
                            "from members where memberid= '" & _
                            Trim(txtMemId.Text) & "'", db, _
                            adOpenStatic, adLockOptimistic
        If lblres.Caption = Trim(txtMemId.Text) Then
            adoprimaryrs6.Fields(2) = adoprimaryrs6.Fields(1) + _
                                        adoprimaryrs2.Fields(4)
        End If
        adoprimaryrs6.Fields(1) = adoprimaryrs6.Fields(1) + 1
        adoprimaryrs6.Update
        txtBookId_LostFocus
        Txtmemid_LostFocus
        txtMemId.SetFocus
    End If
End Sub
Private Sub cmdrenewal_Click()
    Dim adoprimaryrs1 As Recordset
    Set adoprimaryrs1 = New Recordset
    '查询会员所拥有的书籍
    adoprimaryrs1.Open "select memberid,BOOKID,ISIN,returndate," & _
                        "issuecounter from books where memberid='" & _
                        Trim(txtMemId.Text) & "' and bookid='" & _
                        Trim(txtBookId.Text) & "'", db, _
                        adOpenStatic, adLockOptimistic
    If adoprimaryrs1.RecordCount = 0 Then
        MsgBox "会员:" & txtMemId & "并没有借这本书书:" & _
                txtBookId, vbInformation
    Exit Sub
    End If
    returndate = adoprimaryrs1.Fields(3)
    '判断借书是否超期
    If returndate < Date Then
        MsgBox "您无法续借这本书:" & txtBookId + vbCrLf + vbCrLf + _
                "请归还书籍且支付罚款.", vbInformation
        Exit Sub
    End If
    IssueCounter = adoprimaryrs1.Fields(4)
    '判断是否超出续借限制
    If IssueCounter > M.RenewalCounter Then
        MsgBox "您无法续借这本书:" + txtBookId + vbCrLf + " 用户:" & _
                txtMemId & "已经超出续借限制", vbInformation
        Exit Sub
    End If
    '获取当前书籍的主题
    Dim adoprimaryrs11 As Recordset
    Set adoprimaryrs11 = New Recordset
    adoprimaryrs11.Open "select Subject from Titles where " & _
                        "titleid ='" & lbltitle.Caption & "'", _
                        db, adOpenStatic, adLockOptimistic
    subj = adoprimaryrs11.Fields(0)
    '获取当前主题的借阅时间长度以确定归还日期
    Dim adoprimaryrs12 As Recordset
    Set adoprimaryrs12 = New Recordset
    adoprimaryrs12.Open "select issuedays,subject from Subjects " & _
                        "where Subject='" & subj & "'", db, _
                        adOpenStatic, adLockOptimistic
    SubjectReturnDate = adoprimaryrs12.Fields(0)
    adoprimaryrs1.Fields(3) = DateAdd("d", SubjectReturnDate, returndate)
    adoprimaryrs1.Fields(4) = adoprimaryrs1.Fields(4) + 1
    adoprimaryrs1.Update
    lblreturn.Caption = adoprimaryrs1(3)
End Sub

Private Sub cmdReserve_Click()
    '判断图书馆中是否有此书籍
    If UCase(lblisin.Caption) = "TRUE" Then
        MsgBox "图书馆现有此书籍,无需预定.", vbInformation
        txtBookId.Text = ""
        txtMemId.SetFocus
        Exit Sub
    End If
    '判断此书已被其他人预定
    If Not lblres.Caption = "0" And Trim(lblres.Caption) <> _
        Trim(txtMemId.Text) Then
        
        MsgBox "这本书被" & lblres.Caption & "预定", vbInformation
        txtBookId.Text = ""
        txtMemId.SetFocus
        Exit Sub
    End If
    '预定此书
    Dim adoprimaryrs As Recordset
    Set adoprimaryrs = New Recordset
    adoprimaryrs.Open "select memberid,reserveid,bookid from books ", db, _
                        adOpenStatic, adLockOptimistic
    adoprimaryrs.Find ("BookId='" & txtBookId.Text & "'")
    adoprimaryrs.Fields(1) = Trim(txtMemId)
    adoprimaryrs.Update
    Txtmemid_LostFocus
    txtBookId_LostFocus
End Sub

Private Sub cmdreturn_Click()
    Dim adoprimaryrs1 As Recordset
    Dim adoprimaryrs11 As Recordset
    Dim adoprimaryrs12 As Recordset
    Dim adoprimaryrs13 As Recordset
    Set adoprimaryrs1 = New Recordset
    adoprimaryrs1.Open "select MemberId,BookId,IsIn,ReturnDate," & _
                        "IssueCounter from Books where MemberId='" & _
                        Trim(txtMemId.Text) & "' and bookid='" & _
                        Trim(txtBookId.Text) & "'", db, _
                        adOpenStatic, adLockOptimistic
    If adoprimaryrs1.RecordCount = 0 Then
        MsgBox "会员:" & txtMemId & "并没有借这本书:" & _
                txtBookId, vbInformation
        Exit Sub
    End If
    If adoprimaryrs1.Fields(2) = True Then
        MsgBox "书:" & txtBookId & "已经归还图书馆.", vbInformation
        Exit Sub
    End If
    '获取书籍原定归还日期
    returndate = adoprimaryrs1.Fields(3)
    If returndate < Date Then
        '借书超期
        '获取超期天数
        FineDays = DateDiff("d", returndate, Date)
        '获取当前书籍的主题
        Set adoprimaryrs11 = New Recordset
        adoprimaryrs11.Open "select Subject from Titles where " & _
                            "titleid ='" & lbltitle.Caption & "'", _
                            db, adOpenStatic, adLockOptimistic
        subj = adoprimaryrs11.Fields(0)
        Set adoprimaryrs12 = New Recordset
        adoprimaryrs12.Open "select issuedays,subject,finecharge " & _
                            "from Subjects where Subject='" & subj & _
                            "'", db, adOpenStatic, adLockOptimistic
        '获取超期单位罚款数额
        FineCharge = adoprimaryrs12.Fields(2)
        MsgBox "当前会员持有书籍:" & txtBookId & "超过" & FineDays & _
                " 天,需要支付:" & FineDays * FineCharge & "", _
                vbInformation, "超期"
        Set adoprimaryrs13 = New Recordset
        adoprimaryrs13.Open "select MemberID,BooksInHand,FineBal " & _
                            "from Members where MemberId = '" & _
                            Trim(txtMemId) & "'", db, _
                            adOpenStatic, adLockOptimistic
        '借书数-1
        adoprimaryrs13.Fields(1) = adoprimaryrs13.Fields(1) - 1
        '罚款数额计算
        adoprimaryrs13.Fields(2) = adoprimaryrs13.Fields(2) + _
                                    (FineDays * FineCharge)
        '书籍存在于图书馆中
        adoprimaryrs1.Fields(2) = "True"
        adoprimaryrs1.Fields(0) = "0"
        adoprimaryrs13.Update
        adoprimaryrs1.Update
    Else
        '书籍按时归还
        Set adoprimaryrs13 = New Recordset
        adoprimaryrs13.Open "select MemberID,BooksInHand,FineBal " & _
                            "from Members where MemberId = '" & _
                            Trim(txtMemId) & "'", db, _
                            adOpenStatic, adLockOptimistic
        '借书数-1
        adoprimaryrs13.Fields(1) = adoprimaryrs13.Fields(1) - 1
        '书籍存在于图书馆中
        adoprimaryrs1.Fields(2) = "True"
        adoprimaryrs1.Fields(0) = "0"
        adoprimaryrs13.Update
        adoprimaryrs1.Update
      
    End If
End Sub

Private Sub cmdMiss_Click()
    Dim adoprimaryrs1 As Recordset
    Set adoprimaryrs1 = New Recordset
    adoprimaryrs1.Open "select MemberId,BOOKID,ISIN,returndate," & _
                        "issuecounter,condition from books where " & _
                        "memberid='" & Trim(txtMemId.Text) & _
                        "' and bookid='" & Trim(txtBookId.Text) & "'", _
                        db, adOpenStatic, adLockOptimistic
    '判断是否会员是否借出此书
    If adoprimaryrs1.RecordCount = 0 Then
        MsgBox "会员:" & txtMemId & "并没有借这本书:" & _
                txtBookId, vbInformation
        Exit Sub
    Else
        Dim adoprimaryrs2 As Recordset
        Set adoprimaryrs2 = New Recordset
        adoprimaryrs2.Open "select price from titles,books where " & _
                            "titles.titleid = books.titleid and " & _
                            "books.bookid='" & Trim(txtBookId.Text) & _
                            "'", db, adOpenStatic, adLockOptimistic
        Dim adoprimaryrs3 As Recordset
        Set adoprimaryrs3 = New Recordset
        adoprimaryrs3.Open "select FineBal,memberid from Members " & _
                            "where MemberId = '" & Trim(txtMemId) & "'", _
                            db, adOpenStatic, adLockOptimistic
        '计算罚款数额
        adoprimaryrs3.Fields(0) = adoprimaryrs3.Fields(0) + _
                                    adoprimaryrs2.Fields(0)
        '更新书本状况
        adoprimaryrs1.Fields(5) = "MISSING"
        adoprimaryrs1.Update
        adoprimaryrs3.Update
        MsgBox "这本书被标记为""丢失"",赔偿的费用已在会员账户中扣除.", _
                vbInformation
    End If

End Sub

Private Sub Form_Load()
    Set db = New Connection
    db.CursorLocation = adUseClient
    db.Open strConnection
End Sub

Private Sub Form_Unload(Cancel As Integer)
    MDImain.munIssue.Enabled = True
    MDImain.munRenewal.Enabled = True
    MDImain.munReturn.Enabled = True
End Sub
Private Sub txtBookId_LostFocus()
    Dim adoprimaryrs As Recordset
    If Trim(txtBookId) = "" Then
        MsgBox "请输入书本编号", vbInformation
    Else
        txtBookId.Text = UCase(txtBookId)
        Set adoprimaryrs = New Recordset
        adoprimaryrs.Open "select titleid,reserveid,condition,isin from Books where BookId = '" & Trim(txtBookId) & "'", db, adOpenStatic, adLockOptimistic
        On Error GoTo oerr1:
        lbltitle.Caption = adoprimaryrs.Fields(0)
        lblres.Caption = adoprimaryrs.Fields(1)
        lblcondt.Caption = adoprimaryrs.Fields(2)
        lblisin.Caption = adoprimaryrs.Fields(3)
    End If
    Exit Sub
oerr1:
    MsgBox "没有这本书.请重试", vbInformation + vbOKOnly, "注意"
    txtBookId.Text = ""
    txtBookId.SetFocus
End Sub

Private Sub Txtmemid_LostFocus()
    Dim adoprimaryrs As Recordset
    If Trim(txtMemId) = "" Then
        MsgBox "请输入会员编号", vbInformation
    Else
        txtMemId.Text = UCase(txtMemId)
        Set adoprimaryrs = New Recordset
        adoprimaryrs.Open "select FirstName,LastName,BooksInHand,FineBal from Members where MemberId = '" & Trim(txtMemId) & "'", db, adOpenStatic, adLockOptimistic
        On Error GoTo oerr
        lblmemname.Caption = adoprimaryrs.Fields(0) & " " & adoprimaryrs.Fields(1)
        lblfinebal.Caption = adoprimaryrs.Fields(3)
        lblbooks.Caption = adoprimaryrs.Fields(2)
    End If
    Exit Sub
oerr:
    MsgBox "没有这个会员,请重试", vbInformation + vbOKOnly, "注意"
    txtMemId.Text = ""
    txtMemId.SetFocus
End Sub