expensedetail.cls

VB6数据库开发指南》的配套源程序

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ExpenseDetail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

'local variable(s) to hold property value(s)
Private mvarlngExpenseId As Long 'local copy
Private mvarstrEmployeeId As String 'local copy
Private mvarstrExpenseType As String 'local copy
Private mvarcurAmountSpent As Currency 'local copy
Private mvarstrDescription As String 'local copy
Private mvardtmDatePurchased As Date 'local copy
Private mvardtmDateSubmitted As Date 'local copy
Private mvarstrDbName As String 'local copy
' Database variables needed to keep track of current
' database condition
Private mdbExpense As Database
Private mrecExpense As Recordset
Private mblnRecSetOpen As Boolean
Private Sub ClearObject()
' Clears all object variables
    
    mvarlngExpenseId = 0
    mvarstrEmployeeId = ""
    mvarstrExpenseType = ""
    mvarcurAmountSpent = 0
    mvarstrDescription = ""
    mvardtmDatePurchased = CDate("1/1/1980")
    mvardtmDateSubmitted = CDate("1/1/1980")
    
End Sub

Public Function Delete() As String
' Deletes the expense detail record whose value is current from the
' database
    
    On Error GoTo DeleteError
    
    With mrecExpense
        .Delete
        If 0 = .RecordCount Then
            Call ClearObject
        Else
            .MoveNext
            If .EOF Then
                Call ClearObject
            Else
                Call GetRecordset(mrecExpense)
            End If
        End If
    End With
    
    Delete = "OK"
    
    Exit Function

DeleteError:
    ' Return the error description
    Delete = Err.Description
    Err.Clear
    Exit Function
    
End Function

Public Function Insert() As String
' Inserts a brand new record into the database and leaves the newly
' inserted values as the current object values.

    On Error GoTo InsertError
    With mrecExpense
    
        .AddNew
        mvardtmDateSubmitted = Now
        Call SetRecordset(mrecExpense)
        .Update
        'Move to the most recently modified record
        .Bookmark = .LastModified
        Call GetRecordset(mrecExpense)
    End With
    
    Insert = "OK"
    
    Exit Function

InsertError:
    ' Return the error description
    Insert = Err.Description
    Err.Clear
    Exit Function

End Function
Public Function Update() As String
' Updates Expenses table from current object values
Dim strSql As String

    On Error GoTo UpdateError
    With mrecExpense
        .Edit
        Call SetRecordset(mrecExpense)
        .Update
        .Bookmark = .LastModified
        Call GetRecordset(mrecExpense)
    End With
    Update = "OK"
    
    Exit Function

UpdateError:
    ' Return the error description
    Update = Err.Description
    Err.Clear
    Exit Function
End Function

Public Property Let strDbName(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.strDbName = 5

    On Error GoTo OpenError
    
    If mblnRecSetOpen Then
        mrecExpense.Close
        mdbExpense.Close
    End If
    mvarstrDbName = vData
    Set mdbExpense = DBEngine.Workspaces(0).OpenDatabase(mvarstrDbName)
    Set mrecExpense = mdbExpense.OpenRecordset("Expenses")
    mblnRecSetOpen = True
    
    Exit Property

OpenError:
    ' Since we are designing this class for potential unattended operation,
    ' we'll have to raise an error on our own
    Err.Raise Number:=Err.Number
    Err.Clear
    Exit Property
    
End Property

Public Property Get strDbName() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.strDbName
    strDbName = mvarstrDbName
End Property
Public Function MoveNext() As String
' Moves to next Expenses table record and sets current object values

    On Error GoTo MoveError
    
    With mrecExpense
        If True = .BOF _
        And True = .EOF Then
            ' Empty recordset
            MoveNext = "EOF"
        Else
            ' Move to the next record
            .MoveNext
            If mrecExpense.EOF Then
                MoveNext = "EOF"
            Else
                Call GetRecordset(mrecExpense)
                MoveNext = "OK"
            End If
        End If
    End With
    
    Exit Function
    
MoveError:
    ' Return the error description
    MoveNext = Err.Description
    Err.Clear
    Exit Function
End Function

Public Function MovePrev() As String
' Retrieve the record prior to the current one

    On Error GoTo MoveError
    
    With mrecExpense
    
        If True = .BOF _
        And True = .EOF Then
            ' Empty recordset
            MovePrev = "BOF"
        Else
            ' Move to the previous record
            .MovePrevious
            If .BOF Then
                MovePrev = "BOF"
            Else
                Call GetRecordset(mrecExpense)
                MovePrev = "OK"
            End If
        End If
        
    
    End With
    
    Exit Function
    
MoveError:
    ' Return the error description
    MovePrev = Err.Description
    Err.Clear
    Exit Function
End Function

Public Function MoveLast() As String
' Retrieve the last record

    On Error GoTo MoveError
    
    With mrecExpense
        If True = .BOF _
        And True = .EOF Then
            ' Empty recordset
            MoveLast = "EOF"
        Else
            ' Move to the last record
            .MoveLast
            Call GetRecordset(mrecExpense)
            MoveLast = "OK"
        End If
    End With
    
    Exit Function

MoveError:
    ' Return the error description
    MoveLast = Err.Description
    Err.Clear
    Exit Function
End Function

Public Function MoveFirst() As String
' Retrieve the first record

    On Error GoTo MoveError
    With mrecExpense
        If True = .BOF _
        And True = .EOF Then
            ' Empty recordset
            MoveFirst = "BOF"
        Else
            ' Move to the first record
            .MoveFirst
            Call GetRecordset(mrecExpense)
            MoveFirst = "OK"
        End If
    End With
    
    Exit Function

MoveError:
    ' Return the error description
    MoveFirst = Err.Description
    Err.Clear
    Exit Function
End Function

Public Property Get dtmDateSubmitted() As Date
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.dtmDateSubmitted
    dtmDateSubmitted = mvardtmDateSubmitted
End Property

Public Property Let dtmDatePurchased(ByVal vData As Date)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.dtmDatePurchased = 5
    mvardtmDatePurchased = vData
End Property

Public Property Get dtmDatePurchased() As Date
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.dtmDatePurchased
    dtmDatePurchased = mvardtmDatePurchased
End Property

Public Property Let strDescription(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.strDescription = 5
    mvarstrDescription = vData
End Property

Public Property Get strDescription() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.strDescription
    strDescription = mvarstrDescription
End Property

Public Property Let curAmountSpent(ByVal vData As Currency)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.curAmountSpent = 5
    mvarcurAmountSpent = vData
End Property

Public Property Get curAmountSpent() As Currency
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.curAmountSpent
    curAmountSpent = mvarcurAmountSpent
End Property

Public Function strSetExpenseType(ByVal vData As String) As String
' Sets the expense type to an allowed value
    Dim strTemp As String
    strTemp = UCase$(vData)
    
    If strTemp = "TRAVEL" _
    Or strTemp = "MEALS" _
    Or strTemp = "OFFICE" _
    Or strTemp = "AUTO" _
    Or strTemp = "TOLL/PARK" Then
        mvarstrExpenseType = strTemp
        strSetExpenseType = "OK"
    Else
        strSetExpenseType = "Expense type must be TRAVEL, MEALS, " _
                            & "OFFICE, AUTO, or TOLL/PARK"
    End If
    
End Function
Public Property Get strExpenseType() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.strExpenseType
    strExpenseType = mvarstrExpenseType
End Property

Public Property Let strEmployeeId(ByVal vData As String)
'used when assigning a value to the property, on the left side of an assignment.
'Syntax: X.strEmployeeId = 5
    mvarstrEmployeeId = vData
End Property

Public Property Get strEmployeeId() As String
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.strEmployeeId
    strEmployeeId = mvarstrEmployeeId
End Property

Public Property Get lngExpenseId() As Long
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.lngExpenseId
    lngExpenseId = mvarlngExpenseId
End Property

Private Sub Class_Initialize()
    
    ' Indicate the the database is not yet open
    mblnRecSetOpen = False
    ' Clear all object variables
    Call ClearObject
    
End Sub

Private Sub Class_Terminate()

    ' We don't really care about errors when cleaning up.
    On Error Resume Next
    ' Close the recordset
    mrecExpense.Close
    ' Close the expense database
    mdbExpense.Close
    ' Reset the error handler
    On Error GoTo 0
    Exit Sub
    
End Sub
Private Sub SetRecordset(recExp As Recordset)
' Copies current values to Recordset

    With recExp
        !EmployeeId = mvarstrEmployeeId
        !ExpenseType = mvarstrExpenseType
        !AmountSpent = mvarcurAmountSpent
        !Description = mvarstrDescription
        !DatePurchased = mvardtmDatePurchased
        !DateSubmitted = mvardtmDateSubmitted
    End With
    
End Sub
Private Sub GetRecordset(recExp As Recordset)
' Copies current values to Recordset

    With recExp
        mvarlngExpenseId = 0 + !ExpenseID
        mvarstrEmployeeId = "" & !EmployeeId
        mvarstrExpenseType = "" & !ExpenseType
        mvarcurAmountSpent = 0 + !AmountSpent
        mvarstrDescription = "" & !Description
        mvardtmDatePurchased = !DatePurchased
        mvardtmDateSubmitted = !DateSubmitted
    End With
    
End Sub