employee.cls

完整的三层数据库应用程序

    
  With adoRS
    Do While Not .EOF
      Set uEmployee = Nothing
      Set uEmployee = New Employee
      uEmployee.Address= IIF(IsNull(adoRS("Address")), "", adoRS("Address"))
      uEmployee.BillingRate= IIF(IsNull(adoRS("BillingRate")), 0, adoRS("BillingRate"))
      uEmployee.City= IIF(IsNull(adoRS("City")), "", adoRS("City"))
      uEmployee.Country= IIF(IsNull(adoRS("Country")), "", adoRS("Country"))
      uEmployee.EmployeeID= IIF(IsNull(adoRS("EmployeeID")), 0, adoRS("EmployeeID"))
      uEmployee.Extension= IIF(IsNull(adoRS("Extension")), "", adoRS("Extension"))
      uEmployee.FirstName= IIF(IsNull(adoRS("FirstName")), "", adoRS("FirstName"))
      uEmployee.LastName= IIF(IsNull(adoRS("LastName")), "", adoRS("LastName"))
      uEmployee.PostalCode= IIF(IsNull(adoRS("PostalCode")), "", adoRS("PostalCode"))
      uEmployee.StateOrProvince= IIF(IsNull(adoRS("StateOrProvince")), "", adoRS("StateOrProvince"))
      uEmployee.Title= IIF(IsNull(adoRS("Title")), "", adoRS("Title"))
      uEmployee.WorkPhone= IIF(IsNull(adoRS("WorkPhone")), "", adoRS("WorkPhone"))
      uEmployee.OldEmployeeID = uEmployee.EmployeeID
	
      uEmployee.IsDirty = False 
      uEmployee.IsNew = False 
      uEmployee.ReSetBrokenRule False
      uEmployees.AddExisting uEmployee, ":" & uEmployee.EmployeeID 
      If GetChildren Then uEmployee.TimeCards.LoadRelated uEmployee.EmployeeID

      .MoveNext
    Loop
    .Close
  End With

  Set LoadByLastName = uEmployees
  Exit Function

Err_LoadByLastName:
  ErrNum = Err.Number
  ErrMsg = Err.Description
  Call ErrHandler(ErrNum, ErrMsg,"Employee","LoadByLastName")
End Function
	 
'******************************************************************************
'*                                                                            *
'* Name:    LoadByStateOrProvince                                   *
'*                                                                            *
'* Purpose: Load records based on StateOrProvince                         *
'*          Optionally you can include orderby clause to sort data.           *  
'*                                                                            *
'* Return: a Employees object                  *
'******************************************************************************
Function LoadByStateOrProvince(ByVal vStateOrProvince As String , Optional ByVal OrderByClause As String = vbNullString , Optional GetChildren As Boolean = False) As Employees
  On Error GoTo Err_LoadByStateOrProvince
  Dim adoRS As New ADODB.Recordset
  Dim strSQL As String
  Dim uEmployee As Employee
  Dim uEmployees As New Employees

  strSQL = "Select a.Address,a.BillingRate,a.City,a.Country,a.EmployeeID,a.Extension,a.FirstName,a.LastName,a.PostalCode,a.StateOrProvince,a.Title,a.WorkPhone From Employees a Where a.StateOrProvince Like '" & vStateOrProvince & "'" & OrderByClause

  adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    
  With adoRS
    Do While Not .EOF
      Set uEmployee = Nothing
      Set uEmployee = New Employee
      uEmployee.Address= IIF(IsNull(adoRS("Address")), "", adoRS("Address"))
      uEmployee.BillingRate= IIF(IsNull(adoRS("BillingRate")), 0, adoRS("BillingRate"))
      uEmployee.City= IIF(IsNull(adoRS("City")), "", adoRS("City"))
      uEmployee.Country= IIF(IsNull(adoRS("Country")), "", adoRS("Country"))
      uEmployee.EmployeeID= IIF(IsNull(adoRS("EmployeeID")), 0, adoRS("EmployeeID"))
      uEmployee.Extension= IIF(IsNull(adoRS("Extension")), "", adoRS("Extension"))
      uEmployee.FirstName= IIF(IsNull(adoRS("FirstName")), "", adoRS("FirstName"))
      uEmployee.LastName= IIF(IsNull(adoRS("LastName")), "", adoRS("LastName"))
      uEmployee.PostalCode= IIF(IsNull(adoRS("PostalCode")), "", adoRS("PostalCode"))
      uEmployee.StateOrProvince= IIF(IsNull(adoRS("StateOrProvince")), "", adoRS("StateOrProvince"))
      uEmployee.Title= IIF(IsNull(adoRS("Title")), "", adoRS("Title"))
      uEmployee.WorkPhone= IIF(IsNull(adoRS("WorkPhone")), "", adoRS("WorkPhone"))
      uEmployee.OldEmployeeID = uEmployee.EmployeeID
	
      uEmployee.IsDirty = False 
      uEmployee.IsNew = False 
      uEmployee.ReSetBrokenRule False
      uEmployees.AddExisting uEmployee, ":" & uEmployee.EmployeeID 
      If GetChildren Then uEmployee.TimeCards.LoadRelated uEmployee.EmployeeID

      .MoveNext
    Loop
    .Close
  End With

  Set LoadByStateOrProvince = uEmployees
  Exit Function

Err_LoadByStateOrProvince:
  ErrNum = Err.Number
  ErrMsg = Err.Description
  Call ErrHandler(ErrNum, ErrMsg,"Employee","LoadByStateOrProvince")
End Function
	 
'******************************************************************************
'*                                                                            *
'* Name:    LoadByTitle                                   *
'*                                                                            *
'* Purpose: Load records based on Title                         *
'*          Optionally you can include orderby clause to sort data.           *  
'*                                                                            *
'* Return: a Employees object                  *
'******************************************************************************
Function LoadByTitle(ByVal vTitle As String , Optional ByVal OrderByClause As String = vbNullString , Optional GetChildren As Boolean = False) As Employees
  On Error GoTo Err_LoadByTitle
  Dim adoRS As New ADODB.Recordset
  Dim strSQL As String
  Dim uEmployee As Employee
  Dim uEmployees As New Employees

  strSQL = "Select a.Address,a.BillingRate,a.City,a.Country,a.EmployeeID,a.Extension,a.FirstName,a.LastName,a.PostalCode,a.StateOrProvince,a.Title,a.WorkPhone From Employees a Where a.Title Like '" & vTitle & "'" & OrderByClause

  adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    
  With adoRS
    Do While Not .EOF
      Set uEmployee = Nothing
      Set uEmployee = New Employee
      uEmployee.Address= IIF(IsNull(adoRS("Address")), "", adoRS("Address"))
      uEmployee.BillingRate= IIF(IsNull(adoRS("BillingRate")), 0, adoRS("BillingRate"))
      uEmployee.City= IIF(IsNull(adoRS("City")), "", adoRS("City"))
      uEmployee.Country= IIF(IsNull(adoRS("Country")), "", adoRS("Country"))
      uEmployee.EmployeeID= IIF(IsNull(adoRS("EmployeeID")), 0, adoRS("EmployeeID"))
      uEmployee.Extension= IIF(IsNull(adoRS("Extension")), "", adoRS("Extension"))
      uEmployee.FirstName= IIF(IsNull(adoRS("FirstName")), "", adoRS("FirstName"))
      uEmployee.LastName= IIF(IsNull(adoRS("LastName")), "", adoRS("LastName"))
      uEmployee.PostalCode= IIF(IsNull(adoRS("PostalCode")), "", adoRS("PostalCode"))
      uEmployee.StateOrProvince= IIF(IsNull(adoRS("StateOrProvince")), "", adoRS("StateOrProvince"))
      uEmployee.Title= IIF(IsNull(adoRS("Title")), "", adoRS("Title"))
      uEmployee.WorkPhone= IIF(IsNull(adoRS("WorkPhone")), "", adoRS("WorkPhone"))
      uEmployee.OldEmployeeID = uEmployee.EmployeeID
	
      uEmployee.IsDirty = False 
      uEmployee.IsNew = False 
      uEmployee.ReSetBrokenRule False
      uEmployees.AddExisting uEmployee, ":" & uEmployee.EmployeeID 
      If GetChildren Then uEmployee.TimeCards.LoadRelated uEmployee.EmployeeID

      .MoveNext
    Loop
    .Close
  End With

  Set LoadByTitle = uEmployees
  Exit Function

Err_LoadByTitle:
  ErrNum = Err.Number
  ErrMsg = Err.Description
  Call ErrHandler(ErrNum, ErrMsg,"Employee","LoadByTitle")
End Function
	


'******************************************************************************
'*                                                                            *
'* Name:    CopyMe                                                            *
'*                                                                            *
'* Purpose: this method make another copy of this object in the memory        *
'*                                                                            *
'* Returns: Another Employee.                              *
'*                                                                            *
'******************************************************************************
Public Function CopyMe() As Employee
  Dim uEmployee As New Employee

  uEmployee.Address = m_Address
  uEmployee.BillingRate = m_BillingRate
  uEmployee.City = m_City
  uEmployee.Country = m_Country
  uEmployee.EmployeeID = m_EmployeeID
  uEmployee.Extension = m_Extension
  uEmployee.FirstName = m_FirstName
  uEmployee.LastName = m_LastName
  uEmployee.PostalCode = m_PostalCode
  uEmployee.StateOrProvince = m_StateOrProvince
  uEmployee.Title = m_Title
  uEmployee.WorkPhone = m_WorkPhone
  uEmployee.IsDirty = m_IsDirty
  uEmployee.IsNew = m_IsNew
  uEmployee.IsDeleted = m_IsDeleted
  uEmployee.OldEmployeeID = m_OldEmployeeID

  Dim uTimeCard As TimeCard
  Dim oTimeCard As TimeCard
  For Each oTimeCard In m_TimeCards
    Set uTimeCard = Nothing
    Set uTimeCard = New TimeCard
    Set uTimeCard = oTimeCard.CopyMe
    uEmployee.TimeCards.AddExisting uTimeCard, m_TimeCards.Key(oTimeCard)
  Next

  Set CopyMe = uEmployee
End Function     


Private Function COMEXDataSourceSingle_GetData(ByVal Field As Long) As Variant
  On Error Resume Next
  If Field > 0 AND Field <= UBound(m_Fields) + 1 Then     
    COMEXDataSourceSingle_GetData = CallByName(Me, m_Fields(Field-1) & "IncludeLookup" , vbGet)
  	If err<>0 Then COMEXDataSourceSingle_GetData = CallByName(Me, m_Fields(Field-1), vbGet)
  Else
    COMEXDataSourceSingle_GetData = vbNullString
  End If
End Function

Private Function COMEXDataSourceSingle_GetDataByName(ByVal FieldName As String) As Variant
  On Error Resume Next
  COMEXDataSourceSingle_GetDataByName = CallByName(Me, FieldName & "IncludeLookup", vbGet)
  If err<>0 Then COMEXDataSourceSingle_GetDataByName = CallByName(Me, FieldName, vbGet)
End Function

Private Function COMEXDataSourceSingle_GetFieldCount() As Long
  COMEXDataSourceSingle_GetFieldCount = UBound(m_Fields) + 1
End Function

Private Function COMEXDataSourceSingle_GetFieldName(ByVal Field As Long) As String
  If Field > 0 AND Field <= UBound(m_Fields) + 1 Then 
    COMEXDataSourceSingle_GetFieldName = m_Fields(Field - 1)
  Else
    COMEXDataSourceSingle_GetFieldName = vbNullString
  End If
End Function

Private Sub COMEXDataSourceSingle_SetData(ByVal Field As Long, ByVal newData As Variant)     
  If Field > 0 AND Field <= UBound(m_Fields) + 1 Then 
    Select Case m_Fields(Field-1)

      Case "Address"
        Me.Address =  newData
      Case "BillingRate"
        Me.BillingRate =  newData
      Case "City"
        Me.City =  newData
      Case "Country"
        Me.Country =  newData
      Case "EmployeeID"
        Me.EmployeeID =  newData
      Case "Extension"
        Me.Extension =  newData
      Case "FirstName"
        Me.FirstName =  newData
      Case "LastName"
        Me.LastName =  newData
      Case "PostalCode"
        Me.PostalCode =  newData
      Case "StateOrProvince"
        Me.StateOrProvince =  newData
      Case "Title"
        Me.Title =  newData
      Case "WorkPhone"
        Me.WorkPhone =  newData
    End Select
  End If
End Sub  

Private Sub COMEXDataSourceSingle_SetDataByName(ByVal FieldName As string, ByVal newData As Variant)     
  Select Case FieldName

    Case "Address"
        Me.Address =  newData
    Case "BillingRate"
        Me.BillingRate =  newData
    Case "City"
        Me.City =  newData
    Case "Country"
        Me.Country =  newData
    Case "EmployeeID"
        Me.EmployeeID =  newData
    Case "Extension"
        Me.Extension =  newData
    Case "FirstName"
        Me.FirstName =  newData
    Case "LastName"
        Me.LastName =  newData
    Case "PostalCode"
        Me.PostalCode =  newData
    Case "StateOrProvince"
        Me.StateOrProvince =  newData
    Case "Title"
        Me.Title =  newData
    Case "WorkPhone"
        Me.WorkPhone =  newData
  End Select  
End Sub

Private Sub COMEXDataSourceSingle_Delete()
  Call Delete
End Sub 

Private Function COMEXDataSourceSingle_Save() As Boolean
  COMEXDataSourceSingle_Save = Save
End Function 

Private Function COMEXDataSourceSingle_CopyMe() As COMEXDataSourceSingle
  Set COMEXDataSourceSingle_CopyMe = CopyMe
End Function

Private Property Get COMEXDataSourceSingle_IsDeleted() As Boolean
  COMEXDataSourceSingle_IsDeleted = IsDeleted
End Property