ht202.cls

《VB6数据库开发指南》所有的例程的源码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CTitles"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

' The CTitles class provides a light wrapper
' around the database and record for the
' Titles table in the Biblio database

' Note: It's up to the client to save

' Database and recordset objects
Private mdb As Database
Private mrs As Recordset

' Flags
' dirty flag
Private mblnIsDirty As Boolean

' Fields
' title
Private mstrTitle As String
' year - note use of string for
' assignment to text box
Private mstrYearPublished As String
' ISBN number
Private mstrISBN As String
' PubID - also a string
Private mstrPubID As String

' Move method constants
Public Enum CTitlesMove
    FirstRecord = 1
    LastRecord = 2
    NextRecord = 3
    PreviousRecord = 4
End Enum

' Error constants
' Note: RaiseClassError method provides the strings
' because you cannot assign a string to an Enum
Public Enum CTitlesError
    ErrMissingTitle = vbObjectError + 1000 + 1
    ErrMissingYear = vbObjectError + 1000 + 2
    ErrMissingISBN = vbObjectError + 1000 + 3
    ErrInvalidYear = vbObjectError + 1000 + 4
    ErrMissingPubID = vbObjectError + 1000 + 5
    ErrNonNumericPubID = vbObjectError + 1000 + 6
    ErrRecordNotFound = vbObjectError + 1000 + 10
    ErrInvalidMoveType = vbObjectError + 1000 + 11
    ErrNoRecords = vbObjectError + 1000 + 12
End Enum

' Class Events

Private Sub Class_Initialize()

    ' open the database and recordset
    
    Dim strDBName As String
    
    ' Get the database name and open the database.
    ' BiblioPath is a function in READINI.BAS
    strDBName = BiblioPath()
    Set mdb = DBEngine.Workspaces(0).OpenDatabase(strDBName)
    
    ' Open the recordset.
    Set mrs = mdb.OpenRecordset( _
        "Titles", dbOpenDynaset, dbSeeChanges, dbOptimistic)
    
    ' Raise an error if there is no data
    If mrs.BOF Then
        RaiseClassError ErrNoRecords
    End If
    
    ' fetch the first record to the properties
    GetCurrentRecord

End Sub
Private Sub Class_Terminate()
' cleanup - note that since a Class_Terminate error
' is fatal to the app, this proc simply traps and
' ignores any shutdown errors
' that's not a great solution, but there's not much
' else that can be done at this point
' in a production app, it might be helpful to log
' these errors

    ' close and release the recordset object
    mrs.Close
    Set mrs = Nothing
    ' close and release the database object
    mdb.Close
    Set mdb = Nothing

End Sub

' Private procedures

Private Sub RaiseClassError(lngErrorNumber As CTitlesError)
' Note: DAO errors are passed out as-is

    Dim strDescription As String
    Dim strSource As String
    
    ' assign the description for the error
    Select Case lngErrorNumber
        Case ErrMissingTitle
            strDescription = "The Title is required."
        Case ErrMissingYear
            strDescription = "The Year Published is required."
        Case ErrMissingISBN
            strDescription = "The ISBN number is required."
        Case ErrInvalidYear
            strDescription = "Not a valid year."
        Case ErrMissingPubID
            strDescription = "The Publisher ID is required."
        Case ErrNonNumericPubID
            strDescription = "The Publisher ID must be numeric."
        Case ErrRecordNotFound
            strDescription = "The record was not found."
        Case ErrInvalidMoveType
            strDescription = "Invalid move operation."
        Case ErrNoRecords
            strDescription = "There are no records in the Titles table."
        Case Else
            ' If this executes, it's a coding error in
            ' the class module, but having the case is
            ' useful for debugging.
            strDescription = "There is no message for this error."
    End Select
    
    ' build the Source property for the error
    strSource = App.EXEName & ".CTitles"
    
    ' raise it
    Err.Raise lngErrorNumber, strSource, strDescription

End Sub

Private Sub GetCurrentRecord()
' Get current values from the recordset

    ' a zero length string is appended to
    ' each variable to avoid the Invalid use of Null
    ' error if a field is null
    ' although current rules don't allow nulls, there
    ' may be legacy data that doesn't conform to
    ' existing rules
    mstrISBN = mrs![ISBN] & ""
    mstrTitle = mrs![Title] & ""
    mstrYearPublished = mrs![Year Published] & ""
    mstrPubID = mrs![PubID] & ""

End Sub
Private Sub UpdateRecord()
' DAO Edit/Update
On Error GoTo ProcError

    ' inform DAO we will edit
    mrs.Edit
    mrs![ISBN] = mstrISBN
    mrs![Title] = mstrTitle
    mrs![Year Published] = mstrYearPublished
    mrs![PubID] = mstrPubID
    ' commit changes
    mrs.Update
    ' clear dirty flag
    mblnIsDirty = False

    Exit Sub

ProcError:
    ' clear the values that were assigned
    ' and cancel the edit method by
    ' executing a moveprevious/movenext
    mrs.MovePrevious
    mrs.MoveNext
    ' raise the error again
    Err.Raise Err.Number, Err.Source, Err.Description, _
        Err.HelpFile, Err.HelpContext

End Sub

' Public properties

Public Property Get Title() As String
    
    Title = mstrTitle

End Property
Public Property Let Title(strTitle As String)

    mstrTitle = strTitle
    ' set the dirty flag
    mblnIsDirty = True

End Property
Public Property Get YearPublished() As String

    YearPublished = mstrYearPublished
    
End Property
Public Property Let YearPublished(strYearPublished As String)

    mstrYearPublished = strYearPublished
    ' set the dirty flag
    mblnIsDirty = True

End Property
Public Property Get ISBN() As String

    ISBN = mstrISBN

End Property
Public Property Let ISBN(strISBN As String)

    mstrISBN = strISBN
    ' set the dirty flag
    mblnIsDirty = True

End Property
Public Property Get PubID() As String

    PubID = mstrPubID
    
End Property
Public Property Let PubID(strPubID As String)

    mstrPubID = strPubID
    ' set the dirty flag
    mblnIsDirty = True
    
End Property

Public Property Get IsDirty() As Boolean
' pass out the dirty flag

    IsDirty = mblnIsDirty
    
End Property

Public Property Get IsValid(Optional blnRaiseError As Boolean = False) As Boolean
' test the data against our rules
' the optional blnRaiseError flag can be used to have the
' procedure raise an error if a validation rule is
' violated.

    Dim lngError As CTitlesError

    If mstrISBN = "" Then
        lngError = ErrMissingISBN
    ElseIf mstrTitle = "" Then
        lngError = ErrMissingTitle
    ElseIf mstrYearPublished = "" Then
        lngError = ErrMissingYear
    ElseIf Not IsNumeric(mstrYearPublished) Then
        lngError = ErrInvalidYear
    ElseIf mstrPubID = "" Then
        lngError = ErrMissingPubID
    ElseIf Not IsNumeric(mstrPubID) Then
        lngError = ErrNonNumericPubID
    End If

    If lngError <> 0 Then
        If blnRaiseError Then
            RaiseClassError lngError
        Else
            IsValid = False
        End If
    Else
        IsValid = True
    End If

End Property

' Public methods

Public Sub Move(lngMoveType As CTitlesMove)
' Move and refresh properties

    Select Case lngMoveType
        Case FirstRecord
            mrs.MoveFirst
        Case LastRecord
            mrs.MoveLast
        Case NextRecord
            mrs.MoveNext
            ' check for EOF
            If mrs.EOF Then
                mrs.MoveLast
            End If
        Case PreviousRecord
            mrs.MovePrevious
            ' check for BOF
            If mrs.BOF Then
                mrs.MoveFirst
            End If
        Case Else
            ' bad parameter, raise an error
            RaiseClassError ErrInvalidMoveType
    End Select
    
    GetCurrentRecord

End Sub

Public Sub SaveRecord()
' save current changes

    ' test dirty flag
    If mblnIsDirty Then
        ' validate, raise an error
        ' if rules are violated
        If IsValid(True) Then
            ' update it
            UpdateRecord
        End If
    Else
        ' record is already clean
    End If

End Sub