exeexpensedetail.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = 0   'False
END
Attribute VB_Name = "ExeExpenseDetail"
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
Public Function GetField(intColumn As Integer) As Variant
' Return the requested field
    Select Case intColumn
        Case 0
            GetField = mvarlngExpenseId
        Case 1
            GetField = mvarstrEmployeeId
        Case 2
            GetField = mvarstrExpenseType
        Case 3
            GetField = mvarcurAmountSpent
        Case 4
            GetField = mvarstrDescription
        Case 5
            GetField = mvardtmDatePurchased
        Case 6
            GetField = mvardtmDateSubmitted
    
    End Select
    
End Function

Public Function FieldCount() As Integer
    FieldCount = 7
End Function

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

Private 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

Private 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
Private 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

Private 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

    
End Property

Private 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

Private 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

Private 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

Private 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

Private 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

Private 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

Private 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

Private 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
Private 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

Private 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

Private 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

Private 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()
    
    On Error GoTo OpenError
        
    ' Put all the required security code here where it is
    ' protected by compilation.
    mvarstrDbName = App.Path & "\Expense.mdb"
    Set mdbExpense = DBEngine.Workspaces(0).OpenDatabase(mvarstrDbName)
    Set mrecExpense = mdbExpense.OpenRecordset("Expenses")
    mblnRecSetOpen = True
    
    Exit Sub

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 Sub
    
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