frmborrowreturn.frm

本人用VB 6.0和ACCESS编写的图书管理系统

         End
      End
      Begin MSDBGrid.DBGrid DBGrid1 
         Bindings        =   "frmBorrowReturn.frx":1834
         Height          =   2295
         Index           =   1
         Left            =   120
         OleObjectBlob   =   "frmBorrowReturn.frx":184B
         TabIndex        =   61
         Top             =   3360
         Width           =   11175
      End
      Begin MSDBGrid.DBGrid DBGrid2 
         Bindings        =   "frmBorrowReturn.frx":2211
         Height          =   2055
         Index           =   1
         Left            =   120
         OleObjectBlob   =   "frmBorrowReturn.frx":2228
         TabIndex        =   62
         Top             =   6240
         Width           =   11175
      End
   End
End
Attribute VB_Name = "frmBorrowReturn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim ws As Workspace
Dim db As Database, db1 As Database, db2 As Database, db3 As Database
Dim rs As Recordset, rs1 As Recordset, rs2 As Recordset, rs3 As Recordset, rs4 As Recordset
Dim tb As TableDef, fld As Field
Dim strAppName As String, strSQL As String
Dim strName(7) As String, strType(7) As Long, strSize(7) As Long
Const Max = 7

Private Sub cmdBorrow_Click()
    On Error GoTo BorrowErr
    '有效性验证
    If Trim(txtNo(0)) <> Trim(txtCardNo(0)) Or Trim(txtNo(0)) = "" Then
        MsgBox "输入无效！", vbExclamation + vbOKOnly
        Exit Sub
    End If
    
    strAppName = App.Path & "\图书库.mdb"                   '打开图书库
    Set ws = DBEngine.Workspaces(0)
    Set db = ws.OpenDatabase(strAppName, True, False)           '以独占、可写方式打开数据库
    Dim strBookNo As String
    strBookNo = Trim(txtBookNo(0).Text)
    strSQL = "select 图书编号,图书名称,图书总数,现存数量,借出次数,借出标志,遗失标志 from 图书表 where 图书编号='" & strBookNo & "'"
    Set rs = db.OpenRecordset(strSQL)
    Dim intBookCount, intNowCount, intBorrowTime As Integer, blnBorrowFlag, blnLostFlag As Boolean
    intBookCount = rs.Fields("图书总数")
    intNowCount = rs.Fields("现存数量")
    intBorrowTime = rs.Fields("借出次数")
    blnBorrowFlag = rs.Fields("借出标志")
    blnLostFlag = rs.Fields("遗失标志")
    
    strAppName = App.Path & "\借书证库.mdb"                 '打开借书证库
    Set db1 = ws.OpenDatabase(strAppName, True, False)       '以独占、可写方式打开数据库
    Dim strCardNo, strCardStyle As String
    strCardNo = Trim(txtNo(0).Text)
    strCardStyle = Mid(strCardNo, 1, 1)
    strSQL = "select 借书证号,登记日期,押金,借阅数量,作废标志 from 借书证表 where 借书证号='" & strCardNo & "'"
    Set rs1 = db1.OpenRecordset(strSQL)
    Dim intBorrowCount As Integer, dtmRegisterDate As Date, blnCancelFlag As Boolean
    Dim sngDeposit As Single
    sngDeposit = rs1.Fields("押金")
    intBorrowCount = rs1.Fields("借阅数量")
    dtmRegisterDate = rs1.Fields("登记日期")
    blnCancelFlag = rs1.Fields("作废标志")
    strSQL = "select 有效日期,可借书本数,借书天数 from 借书证类型表 where 借书证类型='" & strCardStyle & "'"
    Set rs2 = db1.OpenRecordset(strSQL)
    Dim intBorrowBookCount As Integer, sngAvailable As Single
    Dim dtmValidate, dtmNow As Date
    intBorrowBookCount = rs2.Fields("可借书本数")
    sngAvailable = rs2.Fields("有效日期")
    If sngAvailable <> Int(sngAvailable) Then
        dtmValidate = DateAdd("d", sngAvailable * 365, dtmRegisterDate)
    Else
        dtmValidate = DateAdd("yyyy", sngAvailable, dtmRegisterDate)
    End If
    dtmNow = FormatDateTime(Now, vbShortDate)
    
    '如果现存数量大于0并且借阅数量小于可借书本数,且借书证有效日期大于当前日期,则借书(没有作废的借书证),若遗失完,则该图书作废
    '押金不能为0
    If Not blnCancelFlag _
        And (intNowCount > 0 And intBorrowCount < intBorrowBookCount And dtmNow <= dtmValidate) _
        And Not (blnLostFlag And intBookCount = 0) And sngDeposit > 0 Then
        intNowCount = intNowCount - 1
        intBorrowTime = intBorrowTime + 1
        blnBorrowFlag = True
        rs.Edit
        rs.Fields("现存数量") = intNowCount
        rs.Fields("借出次数") = intBorrowTime
        rs.Fields("借出标志") = blnBorrowFlag
        rs.Update
        
        strAppName = App.Path & "\读者库.mdb"                   '打开读者库
        Set db2 = ws.OpenDatabase(strAppName, True, False)       '以独占、可写方式打开数据库
        Dim strReaderNo As String
        strReaderNo = Mid(strCardNo, 2)
        strSQL = "select 读者编号,借书次数 from 读者表 where 读者编号='" & strReaderNo & "'"
        Set rs3 = db2.OpenRecordset(strSQL)
        Dim intBorrowBookTime As Integer
        intBorrowBookTime = rs3.Fields("借书次数")
        intBorrowBookTime = intBorrowBookTime + 1
        rs3.Edit
        rs3.Fields("借书次数") = intBorrowBookTime
        rs3.Update
        txtBorrowTime(0).Text = intBorrowBookTime
        rs3.Close
        db2.Close
        Set rs3 = Nothing
        Set db2 = Nothing
        
        intBorrowCount = intBorrowCount + 1                 '借阅数量+1
        rs1.Edit
        rs1.Fields("借阅数量") = intBorrowCount
        rs1.Update
        txtBorrowCount(0).Text = intBorrowCount
        
        '向读者借书库中添加记录
        strAppName = App.Path & "\读者借书库.mdb"
        Set db3 = ws.OpenDatabase(strAppName, True, False)          '以独占、可写方式打开数据库
        strSQL = "select * from 读者借书表"
        Set rs4 = db3.OpenRecordset(strSQL)
        Dim intBorrowDay As Integer
        intBorrowDay = rs2.Fields("借书天数")
        Dim dtmBorrowDate, dtmDueReturnDate As Date             '借书日期,应还书日期
        dtmBorrowDate = FormatDateTime(Now, vbShortDate)
        dtmDueReturnDate = DateAdd("d", intBorrowDay, dtmBorrowDate)
        DTBorrowDate.Value = dtmBorrowDate
        DTDueReturnDate(0).Value = dtmDueReturnDate
        rs4.AddNew
        rs4.Fields("借书证号") = strCardNo
        rs4.Fields("所借图书编号") = strBookNo
        rs4.Fields("借书日期") = dtmBorrowDate
        rs4.Fields("应还书日期") = dtmDueReturnDate
        rs4.Update
        rs4.Close
        db3.Close
        Set rs4 = Nothing
        Set db3 = Nothing
        '显示在借图书清单
        strAppName = App.Path & "\图书库.mdb"
        strSQL = "select 图书编号,图书名称,出版社,图书种类,图书总数,现存数量,图书价格 from 图书表 where 图书编号='" & strBookNo & "'"
        Data2(0).DatabaseName = strAppName
        Data2(0).RecordSource = strSQL
        DBGrid2(0).Caption = "在借图书情况"
        Data2(0).Refresh
        Data1(0).Refresh
    Else
        If blnCancelFlag Then
            MsgBox "该借书证已作废！", vbCritical + vbOKOnly
        End If
        If intNowCount = 0 Then
            MsgBox "图书库中无该书,现存数量为0！", vbInformation + vbOKOnly
        End If
        If intBorrowCount = intBorrowBookCount Then
            MsgBox "该借书证只能借" & intBorrowBookCount & "本书！", vbInformation + vbOKOnly
        End If
        If dtmNow > dtmValidate Then
            MsgBox "该借书证有效期已到,不能借书！", vbExclamation + vbOKOnly
            rs1.Edit
            rs1.Fields("作废标志") = True
            rs1.Update
        End If
        If blnLostFlag And intBookCount = 0 Then
            MsgBox "该图书已全部遗失,无法借书！", vbCritical + vbOKOnly
        End If
        If sngDeposit = 0 Then
            MsgBox "押金为0元,请先交押金！", vbExclamation + vbOKOnly
        End If
    End If
    rs2.Close
    rs1.Close
    db1.Close
    Set rs2 = Nothing
    Set rs1 = Nothing
    Set db1 = Nothing
    'rs.Close
    'db.Close
    'Set rs = Nothing
    'Set db = Nothing
    '由于data2与db都绑定图书库,dbdrig2与rs都绑定图书表,所以rs与db都不能关闭
    Exit Sub
BorrowErr:
    MsgBox Err.Description
End Sub

Private Sub cmdBorrowRecord_Click(Index As Integer)
    On Error GoTo RecordErr
    '有效性验证
    If Trim(txtNo(Index)) <> Trim(txtCardNo(Index)) Or Trim(txtNo(Index)) = "" Then
        MsgBox "输入无效！", vbExclamation + vbOKOnly
        Exit Sub
    End If
    
    Dim strCardNo As String
    strCardNo = Trim(txtNo(Index).Text)
    strAppName = App.Path & "\读者借书库.mdb"
    Set ws = DBEngine.Workspaces(0)
    Set db = ws.OpenDatabase(strAppName, True, False)       '以独占、可写方式打开数据库
    strSQL = "select count(*) as 图书总数 from 读者借书表 where 借书证号='" & strCardNo & "' and 还书标志=false"
    Set rs = db.OpenRecordset(strSQL)
    Dim i, intBookCount As Integer, strBookNo() As String
    intBookCount = rs.Fields("图书总数")
    If intBookCount = 0 Then
        MsgBox "该读者没有借书记录！", vbInformation + vbOKOnly
        Exit Sub
    End If
    rs.Close
    
    '创建空借书记录表
    If Not ExistTable(db, "借书记录表") Then
        Set tb = db.CreateTableDef("借书记录表")
        For i = 1 To Max
            Set fld = tb.CreateField()
            With fld
                .Name = strName(i)
                .Type = strType(i)
                .Size = strSize(i)
            End With
            tb.Fields.Append fld
            tb.Fields.Refresh
        Next i
        '添加表
        db.TableDefs.Append tb
        db.TableDefs.Refresh
        Set fld = Nothing
        Set tb = Nothing
    End If
    
    Set rs = Nothing
    strSQL = "select 所借图书编号 from 读者借书表 where 借书证号='" & strCardNo & "' and 还书标志=false"
    Set rs = db.OpenRecordset(strSQL)
    strAppName = App.Path & "\图书库.mdb"
    Set db1 = ws.OpenDatabase(strAppName, False, True)         '以共亨、只读方式打开数据库
    rs.MoveFirst
    ReDim Preserve strBookNo(intBookCount)
    Set rs2 = db.OpenRecordset("借书记录表")
    For i = 1 To intBookCount
        strBookNo(i) = rs.Fields("所借图书编号")
        strSQL = "select 图书编号,图书名称,出版社,图书种类,图书总数,现存数量,图书价格 from 图书表 where 图书编号='" & strBookNo(i) & "'"
        Set rs1 = db1.OpenRecordset(strSQL)
        With rs2
            .AddNew
            .Fields("图书编号") = rs1.Fields("图书编号")
            .Fields("图书名称") = rs1.Fields("图书名称")
            .Fields("出版社") = rs1.Fields("出版社")
            .Fields("图书种类") = rs1.Fields("图书种类")
            .Fields("图书总数") = rs1.Fields("图书总数")
            .Fields("现存数量") = rs1.Fields("现存数量")
            .Fields("图书价格") = rs1.Fields("图书价格")
            .Update
        End With
        rs.MoveNext
    Next i
    strAppName = App.Path & "\读者借书库.mdb"
    Data2(Index).DatabaseName = strAppName
    Data2(Index).RecordSource = "借书记录表"
    DBGrid2(Index).Caption = "借书记录情况"
    Data2(Index).Refresh
    rs2.Close
    Set rs2 = Nothing
    
    '清空借书记录表
    Set rs2 = db.OpenRecordset("借书记录表")
    rs2.MoveFirst
    For i = 1 To intBookCount
        rs2.Delete
        If Not rs2.EOF Then rs2.MoveNext
    Next i
    rs2.Close
    Set rs2 = Nothing
    
    rs1.Close
    db1.Close
    Set rs1 = Nothing
    Set db1 = Nothing
    rs.Close
    db.Close
    Set rs = Nothing
    Set db = Nothing
    Exit Sub
RecordErr:
    MsgBox Err.Description
End Sub

Private Sub cmdCancel_Click(Index As Integer)
    txtNo(Index) = ""
    txtBookNo(Index) = ""
    txtBookName(Index) = ""
    txtCardNo(Index) = ""
    txtName(Index) = ""
    txtDepartment(Index) = ""
    txtClass(Index) = ""
    txtBorrowTime(Index) = ""
    txtBorrowCount(Index) = ""
    DTDueReturnDate(Index).Value = Now
    cmdBorrowRecord(Index).Enabled = False
    If Index = 0 Then
        cmdBorrow.Enabled = False
        DTBorrowDate.Value = Now
    Else
        cmdReturn.Enabled = False
        DTReturnDate.Value = Now
        chkLost.Value = 0           'Unchecked
        chkLost.Enabled = False
        txtAllFee = ""
    End If
End Sub

Private Sub cmdClose_Click(Index As Integer)
    On Error GoTo CloseErr
    Dim strAppName As String
    strAppName = App.Path & "\读者借书库.mdb"
    Set db = Workspaces(0).OpenDatabase(strAppName, True, False)  '独占、可写
    If ExistTable(db, "借书记录表") Then
        '删除表
        Dim i As Integer
        For i = 0 To 1
            Data2(i).DatabaseName = strAppName
            Data2(i).RecordSource = "读者借书表"
            Data2(i).Refresh
        Next
        db.TableDefs.Delete "借书记录表"
    End If
    db.Close
    Set db = Nothing
    Unload Me
    Exit Sub
CloseErr:
    MsgBox Err.Description
End Sub

Private Sub cmdReturn_Click()
    On Error GoTo ReturnErr
    '有效性验证
    If Trim(txtNo(1)) <> Trim(txtCardNo(1)) Or Trim(txtNo(1)) = "" Then
        MsgBox "输入无效！", vbExclamation + vbOKOnly
        Exit Sub
    End If
    '检查该读者是否借过本书
    Dim strCardNo, strBookNo As String
    strCardNo = Trim(txtNo(1).Text)
    strBookNo = Trim(txtBookNo(1).Text)
    strAppName = App.Path & "\读者借书库.mdb"
    Set ws = DBEngine.Workspaces(0)
    Set db3 = ws.OpenDatabase(strAppName, False, True)          '以共享、只读方式打开数据库
    strSQL = "select 借书证号,所借图书编号,借书日期 from 读者借书表 where 借书证号='" & strCardNo & "' and 所借图书编号='" & strBookNo & "'" _
                & " and 还书标志=false"
    Set rs4 = db3.OpenRecordset(strSQL)
    Dim dtmBorrowDate, dtmReturnDate As Date                '借书日期,还书日期
    dtmBorrowDate = rs4.Fields("借书日期")
    dtmReturnDate = FormatDateTime(Now, vbShortDate)
    If rs4.RecordCount = 0 Then
        MsgBox "该读者没有借过这本书！", vbExclamation + vbOKOnly
        rs4.Close
        db3.Close
        Set rs4 = Nothing
        Set db3 = Nothing
        Exit Sub