vrental_engine.cls

中小型图书会员制租赁管理系统,采用ACCESS数据库。

                  txtBirthday As TextBox, txtSex As TextBox, txtCivilStatus As TextBox, txtOccupation As TextBox, _
                  txtContactNumber As TextBox, txtHomeAddress As TextBox, txtOfficeSchoolAddress As TextBox, txtComments As TextBox)     'Load member info to textboxes
    Dim db As Database
    Dim rec As Recordset
    Dim TDM As Variant
    Dim loop1 As Integer
    
    Set db = OpenDatabase(App.Path & "\Database\MembersDB.mdb", False, False, ";pwd=AdmiN")
    Set rec = db.OpenRecordset("MembersInfo", dbOpenTable)
    
    If rec.BOF = True And rec.EOF = True Then Exit Sub 'chk if rec exists   检查纪录是否存在

rec.MoveFirst
    If rec.RecordCount > 0 Then
        For loop1 = 1 To rec.RecordCount
            TDM = DoEvents()
            If lst.Text = rec.Fields("ID NUMBER") & rec.Fields("姓氏") & ", " & rec.Fields("名字1") & Left(rec.Fields("名字2"), 1) Then
                    txtDateEntered.Text = rec.Fields("登记时间")
                    txtIDnumber.Text = rec.Fields("ID NUMBER")
                    txtNationality.Text = rec.Fields("会员等级")
                    txtFirstName.Text = rec.Fields("名字1")
                    txtMiddleName.Text = rec.Fields("名字2")
                    txtFamilyName.Text = rec.Fields("姓氏")
                    txtBirthday.Text = Format(rec.Fields("生日"), "mmm. dd, yyyy")
                    txtSex.Text = rec.Fields("性别")
                    txtCivilStatus.Text = rec.Fields("Civil Status")
                    txtOccupation.Text = rec.Fields("职业")
                    txtContactNumber.Text = rec.Fields("联系号码")
                    txtHomeAddress.Text = rec.Fields("家庭住址")
                    txtOfficeSchoolAddress.Text = rec.Fields("办公/学校地址")
                    txtComments.Text = rec.Fields("读者个性留言")
                    db.Close
                    Exit Sub
            End If
            If rec.EOF = False Then rec.MoveNext
        Next loop1
     End If
  db.Close
  Exit Sub
End Sub
Function AddMemberToDB(txtDateEntered As TextBox, txtIDnumber As TextBox, txtNationality As TextBox, _
                  txtFirstName As TextBox, txtMiddleName As TextBox, txtFamilyName As TextBox, _
                  txtBirthday As TextBox, txtSex As TextBox, txtCivilStatus As TextBox, txtOccupation As TextBox, _
                  txtContactNumber As TextBox, txtHomeAddress As TextBox, txtOfficeSchoolAddress As TextBox, txtComments As TextBox) As Boolean
    Dim db As Database
    Dim rec As Recordset
    Dim TDM As Variant
    Dim loop1 As Integer
    Dim AutoNumber As Long
    AutoNumber = 0 ' init to zero
    Dim Valid As Boolean
    Valid = False  ' Init to False
    
    Set db = OpenDatabase(App.Path & "\Database\MembersDB.mdb", False, False, ";pwd=AdmiN")
    Set rec = db.OpenRecordset("MembersInfo", dbOpenTable)
     '' Start -- Check for valid "New ID" to avoid duplicates
        If rec.BOF = True And rec.EOF = True Then
                AutoNumber = 1
        Else
                Do
                    AutoNumber = AutoNumber + 1
                    rec.MoveFirst
                    Do While (rec.EOF = False)
                        TDM = DoEvents()
                        If Val(rec.Fields("ID NUMBER")) = AutoNumber Then
                                Valid = False
                                Exit Do
                        Else
                                Valid = True
                        End If
                        If rec.EOF = False Then rec.MoveNext
                    Loop
                Loop Until Valid = True
        End If
     '' End -- Check for valid "New ID"
                '' Start update new record fields
                 rec.AddNew
                 rec.Fields("登记时间") = Format(Trim(txtDateEntered.Text), "mm/dd/yyyy")
                 rec.Fields("ID NUMBER") = AutoNumber
                 rec.Fields("会员等级") = Trim(txtNationality.Text)
                 rec.Fields("名字1") = Trim(txtFirstName.Text)
                 rec.Fields("名字2") = Trim(txtMiddleName.Text)
                 rec.Fields("姓氏") = Trim(txtFamilyName.Text)
                 rec.Fields("生日") = Format(Trim(txtBirthday.Text), "mm/dd/yyyy")
                 rec.Fields("性别") = Trim(txtSex.Text)
                 rec.Fields("Civil Status") = (txtCivilStatus.Text)
                 rec.Fields("职业") = Trim(txtOccupation.Text)
                 rec.Fields("联系号码") = Trim(txtContactNumber.Text)
                 rec.Fields("家庭住址") = Trim(txtHomeAddress.Text)
                 rec.Fields("办公/学校地址") = Trim(txtOfficeSchoolAddress.Text)
                 rec.Fields("读者个性留言") = Trim(txtComments.Text)
                 rec.Update
               '' End update new record fields
               db.Close  '' Close DB
               MsgBox "新会员记录已成功添加！ ", vbInformation, "成功更新。"
               AddMemberToDB = True
End Function
Function UpdateEditedMembersDB(txtDateEntered As TextBox, txtIDnumber As TextBox, txtNationality As TextBox, _
                  txtFirstName As TextBox, txtMiddleName As TextBox, txtFamilyName As TextBox, _
                  txtBirthday As TextBox, txtSex As TextBox, txtCivilStatus As TextBox, txtOccupation As TextBox, _
                  txtContactNumber As TextBox, txtHomeAddress As TextBox, txtOfficeSchoolAddress As TextBox, txtComments As TextBox) As Boolean
  'On Error GoTo Err:   如发生错误则跳转到Err:
    Dim db As Database
    Dim rec As Recordset
    Dim TDM As Variant
    Dim loop1 As Integer
    
    Set db = OpenDatabase(App.Path & "\Database\MembersDB.mdb" _
             , False, False, ";pwd=AdmiN")
    Set rec = db.OpenRecordset("MembersInfo", dbOpenTable)
        
        rec.MoveFirst
    '' Start Chk for duplicates sql
    '' End -- chk duplicates
    If rec.RecordCount > 0 Then
        For loop1 = 1 To rec.RecordCount
            TDM = DoEvents()
            If Val(txtIDnumber.Text) = rec.Fields("ID NUMBER") Then
               '' Start update fields
              
                 rec.Edit
                 rec.Fields("登记时间") = Format(Trim(txtDateEntered.Text), "mm/dd/yyyy")
                 ''''rec.Fields("ID NUMBER") = AutoNumber
                 rec.Fields("会员等级") = Trim(txtNationality.Text) ' now used by mem level
                 rec.Fields("名字1") = Trim(txtFirstName.Text)
                 rec.Fields("名字2") = Trim(txtMiddleName.Text)
                 rec.Fields("姓氏") = Trim(txtFamilyName.Text)
                 rec.Fields("生日") = Format(Trim(txtBirthday.Text), "mm/dd/yyyy")
                 rec.Fields("性别") = Trim(txtSex.Text)
                 rec.Fields("Civil Status") = (txtCivilStatus.Text)
                 rec.Fields("职业") = Trim(txtOccupation.Text)
                 rec.Fields("联系号码") = Trim(txtContactNumber.Text)
                 rec.Fields("家庭住址") = Trim(txtHomeAddress.Text)
                 rec.Fields("办公/学校地址") = Trim(txtOfficeSchoolAddress.Text)
                 rec.Fields("读者个性留言") = Trim(txtComments.Text)
                 rec.Update  ''Update the recordset
               '' End update fields
               db.Close  '' Close DB
               MsgBox "成功更新会员数据！ ", vbInformation, "更新"
               UpdateEditedMembersDB = True
               Exit Function
            End If
            rec.MoveNext
        Next loop1
     End If
     
Err:
 db.Close
 MsgBox "更新时发生错误！ ", vbInformation, "Update Error"
 UpdateEditedMembersDB = False
  
End Function
Sub RemoveMember(IDNUMBER As Long)
On Error GoTo Err:
 Dim TDM As Variant
 Dim db As Database
 Dim rec As Recordset
 Set db = OpenDatabase(App.Path & "\Database\MembersDB.mdb", False, False, ";pwd=AdmiN")
 Set rec = db.OpenRecordset("MembersInfo", dbOpenTable)
 rec.MoveFirst
    Do While (rec.EOF = False)
       TDM = DoEvents()
       If Val(rec.Fields("ID NUMBER")) = IDNUMBER Then
           rec.Delete
           Exit Do
       End If
       If rec.EOF = False Then rec.MoveNext
    Loop
 MsgBox "已删除会员！", vbInformation, "更新！"
 db.Close
Err:
End Sub
Sub LoadMoviesList(lst As ListBox, fw1 As String, fw2 As String)
On Error GoTo ErrorHandler:
    Dim db As Database
    Dim rec As Recordset
    Dim TDM As Variant
    Dim loop1, loop2, loop3 As Integer
    lst.Clear
    Set db = OpenDatabase(App.Path & "\Database\CD_Tapes.mdb", False, False, ";pwd=AdmiN")
    Set rec = db.OpenRecordset("CD Tapes Table", dbOpenTable)
    rec.MoveFirst
    If rec.RecordCount > 0 And Val(fw2) >= Val(fw1) Then
     loop1 = rec.RecordCount + 1
       For loop3 = Val(fw1) To Val(fw2)
          rec.MoveFirst
            TDM = DoEvents()
            For loop2 = 1 To rec.RecordCount
            If loop3 > 999 Then
            If rec.Fields("Item Code") <> "CHN-" & Trim(str(loop3)) Then rec.MoveNext
            ElseIf loop3 > 99 Then
            If rec.Fields("Item Code") <> "CHN-0" & Trim(str(loop3)) Then rec.MoveNext
            ElseIf loop3 > 9 Then
            If rec.Fields("Item Code") <> "CHN-00" & Trim(str(loop3)) Then rec.MoveNext
            ElseIf loop3 >= 1 Then
            If rec.Fields("Item Code") <> "CHN-000" & Trim(str(loop3)) Then rec.MoveNext
            Else: Exit For
            End If
            Next loop2
            'lst.AddItem rec.Fields("First Name") & " " & Left(rec.Fields("Middle Name"), 1) & ". " & _
            rec.Fields("姓氏")
           lst.AddItem rec.Fields("标题") & " [" & rec.Fields("Item Code") & "]"
        Next loop3
        booksnum = loop1         '用于添加记录时自动编号的
     End If
  db.Close
  Exit Sub
ErrorHandler:
  db.Close
End Sub
Sub GetCD_TapesInfo(lst As ListBox, txtTitle As TextBox, txtDateEntered As TextBox, txtItemCode As TextBox, _
                    txtAuthor As TextBox, txtYearReleased As TextBox, txtGenre As TextBox, txtRunTime As TextBox, txtRentalAmount As TextBox, _
                    txtAvailable As TextBox, txtRentalPeriod As TextBox, txtOverdueChargePerDay As TextBox, txtLastDateBorrowed As TextBox, txtLastDateBorrowedAddInfo As TextBox, txtLastDateReturned As TextBox, _
                    txtLastDateReturnedAddInfo As TextBox, txtCondition As TextBox, txtComments As TextBox)
    Dim db As Database
    Dim rec As Recordset
    Dim TDM As Variant
    Dim loop1 As Integer
    
    Set db = OpenDatabase(App.Path & "\Database\CD_Tapes.mdb", False, False, ";pwd=AdmiN")
    Set rec = db.OpenRecordset("CD Tapes Table", dbOpenTable)
    If rec.BOF = True And rec.EOF = True Then Exit Sub 'chk if rec exists 检查纪录是否存在

rec.MoveFirst
    If rec.RecordCount > 0 Then
        For loop1 = 1 To rec.RecordCount
            TDM = DoEvents()
            If lst.Text = rec.Fields("标题") & " [" & rec.Fields("Item Code") & "]" Then
                    txtTitle.Text = rec.Fields("标题")
                    txtDateEntered.Text = rec.Fields("入库时间")
                    txtItemCode.Text = rec.Fields("Item Code")
                    txtAuthor.Text = rec.Fields("作者")
                    txtYearReleased.Text = rec.Fields("出版年份")
                    txtGenre.Text = rec.Fields("关键字")
                    txtRunTime.Text = rec.Fields("页数")
                    txtRentalAmount.Text = rec.Fields("Rental Amount")
                    txtAvailable.Text = rec.Fields("是否可租")
                    If IsNull(rec.Fields("RentalPeriod")) = False Then
                       txtRentalPeriod.Text = rec.Fields("RentalPeriod")
                    Else
                       txtRentalPeriod.Text = ""
                    End If
                    
                    If IsNull(rec.Fields("OverdueChargePerDay")) = False Then
                       txtOverdueChargePerDay.Text = rec.Fields("OverdueChargePerDay")
                    Else
                       txtOverdueChargePerDay.Text = ""
                    End If
                    If IsNull(rec.Fields("租借日期")) = False Then
                        txtLastDateBorrowed.Text = rec.Fields("租借日期")
                    Else
                       txtLastDateBorrowed.Text = ""
                    End If
                    
                    If IsNull(rec.Fields("LastDateBorrowedAddInfo")) = False Then
                        txtLastDateBorrowedAddInfo.Text = rec.Fields("LastDateBorrowedAddInfo")
                    Else
                       txtLastDateBorrowedAddInfo.Text = ""
                    End If
                    
                    If IsNull(rec.Fields("LastDateReturned")) = False Then
                        txtLastDateReturned.Text = rec.Fields("LastDateReturned")
                    Else
                        txtLastDateReturned.Text = ""
                    End If
                    
                    If IsNull(rec.Fields("LastDateReturnedAddInfo")) = False Then
                        txtLastDateReturnedAddInfo.Text = rec.Fields("LastDateReturnedAddInfo")
                    Else
                       txtLastDateReturnedAddInfo.Text = ""
                    End If
                    txtCondition.Text = rec.Fields("Condition")
                    If rec.Fields("剩余库存量") <> "" Then
                    txtComments.Text = rec.Fields("剩余库存量")
                    Else
                    txtComments.Text = ""
                    End If
                    db.Close
                    Exit Sub
            End If
            If rec.EOF = False Then rec.MoveNext
        Next loop1
     End If
  db.Close
  Exit Sub
End Sub
Function Add_CD_TAPES_MovieToDB(txtTitle As TextBox, txtDateEntered As TextBox, txtItemCode As TextBox, _
                    txtAuthor As TextBox, txtYearReleased As TextBox, txtGenre As TextBox, txtRunTime As TextBox, txtRentalAmount As TextBox, _
                    txtAvailable As TextBox, txtRentalPeriod As TextBox, txtOverdueChargePerDay As TextBox, txtLastDateBorrowed As TextBox, txtLastDateBorrowedAddInfo As TextBox, txtLastDateReturned As TextBox, _
                    txtLastDateReturnedAddInfo As TextBox, txtCondition As TextBox, txtComments As TextBox) As Boolean
    
    Dim db As Database
    Dim rec As Recordset
    Dim TDM As Variant