timecard.cls

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

  RaiseEvent OnRecordSaved(Me)
Done_Save:
  Exit Function

Err_Save:
  If bolStartTran Then GoSub Rollback_Save
  ErrNum = Err.Number
  ErrMsg = Err.Description
  Call ErrHandler(ErrNum, ErrMsg,"TimeCard","Save")
  GoTo Done_Save
Rollback_Save:
  If bolInTran Then Conn.RollbackTrans
  Return
End Function
'******************************************************************************
'*                                                                            *
'* Name:    Delete                                                            *
'*                                                                            *
'* Purpose: mark this object and it's children as to be deleted when save     *
'*          is callled. Note it doesn't do the deletion in the database.      *
'******************************************************************************
Public Sub Delete()
  m_TimeCardExpenses.Delete
  m_TimeCardHours.Delete

  IsDirty = True
  IsDeleted = True  
End Sub    
'******************************************************************************
'*                                                                            *
'* Name:    DeleteList                                                        *
'*                                                                            *
'* Purpose: Delete record in database based on a where SQL clause.            *
'*          Note it doesn't delete children records.                          *   
'*                                                                            *
'******************************************************************************
Public Function DeleteList(ByVal strDeleteSQL As String) As Boolean
  On Error GoTo Err_DeleteList
  Dim strSQL As String

  strSQL = "DELETE * FROM [Time Cards] " & strDeleteSQL 
  Conn.Execute strSQL
  DeleteList = True
  
  Exit Function
Err_DeleteList:
  ErrNum = Err.Number
  ErrMsg = Err.Description
  Call ErrHandler(ErrNum, ErrMsg,"TimeCard","DeleteList")
End Function
    
'******************************************************************************
'*                                                                            *
'* Name:    Load                                                              *
'*                                                                            *
'* Purpose: Get the specified record. If found, fill this object with correct *
'*          record data. GetChildren is optional so if true get children      *
'*          record as well.                                                   *
'*                                                                            *
'* Returns: Boolean - True (record found); False (otherwise).                 *
'*                                                                            *
'******************************************************************************
Public Function Load(ByVal vTimeCardID As Long, Optional ByVal GetChildren As Boolean = True) As Boolean
  On Error GoTo Err_Load

  Dim adoRS As New ADODB.Recordset
  Dim strSQL As String

  Clear

  strSQL = "Select a.DateEntered,a.EmployeeID,b.FirstName As FirstName,b.LastName As LastName,a.TimeCardID From [Time Cards] a LEFT JOIN Employees b ON a.EmployeeID = b.EmployeeID WHERE a.TimeCardID=" & vTimeCardID & ""

  adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    
  With adoRS
    If Not .EOF Then
      m_DateEntered= IIF(IsNull(adoRS("DateEntered")), "12:00:00AM", adoRS("DateEntered"))
      m_EmployeeID= IIF(IsNull(adoRS("EmployeeID")), 0, adoRS("EmployeeID"))
      m_FirstName= IIF(IsNull(adoRS("FirstName")), "", adoRS("FirstName"))
      m_LastName= IIF(IsNull(adoRS("LastName")), "", adoRS("LastName"))
      m_TimeCardID= IIF(IsNull(adoRS("TimeCardID")), 0, adoRS("TimeCardID"))
      m_OldTimeCardID = m_TimeCardID

	  ReSetBrokenRule False 
    Else
      Load = False
      .Close
      Exit Function
    End If
    .Close
  End With

  If GetChildren Then m_TimeCardExpenses.LoadRelated m_TimeCardID
  If GetChildren Then m_TimeCardHours.LoadRelated m_TimeCardID

  Load = True
  IsDirty = False  
  IsNew = False
  RaiseEvent OnRecordLoad(Me)
  Exit Function

Err_Load:
  ErrNum = Err.Number
  ErrMsg = Err.Description
  Call ErrHandler(ErrNum, ErrMsg,"TimeCard","Load")
End Function


'******************************************************************************
'*                                                                            *
'* Name:    LoadList                                                          *
'*                                                                            *
'* Purpose: Load records based on a where SQL clause.                         *
'*          You can include orderby clause in SQLWhereClause to sort data.    *  
'*                                                                            *
'* Return: a TimeCards object                  *
'******************************************************************************
Function LoadList(Optional ByVal SQLWhereClause As String = vbNullString , Optional GetChildren As Boolean = False) As TimeCards
  On Error GoTo Err_LoadList
  Dim adoRS As New ADODB.Recordset
  Dim strSQL As String
  Dim uTimeCard As TimeCard
  Dim uTimeCards As New TimeCards

  strSQL = "Select a.DateEntered,a.EmployeeID,b.FirstName As FirstName,b.LastName As LastName,a.TimeCardID From [Time Cards] a LEFT JOIN Employees b ON a.EmployeeID = b.EmployeeID" & SQLWhereClause

  adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    
  With adoRS
    Do While Not .EOF
      Set uTimeCard = Nothing
      Set uTimeCard = New TimeCard
      uTimeCard.DateEntered= IIF(IsNull(adoRS("DateEntered")), "12:00:00AM", adoRS("DateEntered"))
      uTimeCard.EmployeeID= IIF(IsNull(adoRS("EmployeeID")), 0, adoRS("EmployeeID"))
      uTimeCard.FirstName= IIF(IsNull(adoRS("FirstName")), "", adoRS("FirstName"))
      uTimeCard.LastName= IIF(IsNull(adoRS("LastName")), "", adoRS("LastName"))
      uTimeCard.TimeCardID= IIF(IsNull(adoRS("TimeCardID")), 0, adoRS("TimeCardID"))
      uTimeCard.OldTimeCardID = uTimeCard.TimeCardID
	
      uTimeCard.IsDirty = False    
      uTimeCard.IsNew = False 
      uTimeCard.ReSetBrokenRule False
      uTimeCards.AddExisting uTimeCard, ":" & uTimeCard.TimeCardID 
      If GetChildren Then uTimeCard.TimeCardExpenses.LoadRelated uTimeCard.TimeCardID
      If GetChildren Then uTimeCard.TimeCardHours.LoadRelated uTimeCard.TimeCardID

      .MoveNext
    Loop
    .Close
  End With

  Set LoadList = uTimeCards
  Exit Function

Err_LoadList:
  ErrNum = Err.Number
  ErrMsg = Err.Description
  Call ErrHandler(ErrNum, ErrMsg,"TimeCard","LoadList")
End Function



'******************************************************************************
'*                                                                            *
'* Name:    GetEmployeesList()                                                  *
'*                                                                            *
'* Purpose: Get the lookup table data into a string.                          *
'*          This is useful for client app to fill combo box                   *
'*                                                                            *
'* Returns: a string with Column delimeter vbTab and row delimeter "|"        *
'*                                                                            *
'******************************************************************************
Function GetEmployeesList(Optional ColDelimeter As string = vbTab, Optional RowDelimeter As string = "|") As String
  Dim adoRs As New ADODB.Recordset
  Dim strSQL As string

  strSQL = "Select EmployeeID,FirstName,LastName from [Employees]"
  With adoRs
    .Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    If Not .EOF Then
      GetEmployeesList = _
        adoRs.GetString(adClipString, , vbTab, "|", vbNullString)
    Else
      GetEmployeesList = vbNullString 
    End If
    .Close
  End With
End Function

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

  uTimeCard.DateEntered = m_DateEntered
  uTimeCard.EmployeeID = m_EmployeeID
  uTimeCard.FirstName = m_FirstName
  uTimeCard.LastName = m_LastName
  uTimeCard.TimeCardID = m_TimeCardID
  uTimeCard.IsDirty = m_IsDirty
  uTimeCard.IsNew = m_IsNew
  uTimeCard.IsDeleted = m_IsDeleted
  uTimeCard.OldTimeCardID = m_OldTimeCardID

  Dim uTimeCardExpense As TimeCardExpense
  Dim oTimeCardExpense As TimeCardExpense
  For Each oTimeCardExpense In m_TimeCardExpenses
    Set uTimeCardExpense = Nothing
    Set uTimeCardExpense = New TimeCardExpense
    Set uTimeCardExpense = oTimeCardExpense.CopyMe
    uTimeCard.TimeCardExpenses.AddExisting uTimeCardExpense, m_TimeCardExpenses.Key(oTimeCardExpense)
  Next


  Dim uTimeCardHour As TimeCardHour
  Dim oTimeCardHour As TimeCardHour
  For Each oTimeCardHour In m_TimeCardHours
    Set uTimeCardHour = Nothing
    Set uTimeCardHour = New TimeCardHour
    Set uTimeCardHour = oTimeCardHour.CopyMe
    uTimeCard.TimeCardHours.AddExisting uTimeCardHour, m_TimeCardHours.Key(oTimeCardHour)
  Next

  Set CopyMe = uTimeCard
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 "DateEntered"
        Me.DateEntered =  newData
      Case "EmployeeID"
        'Why? ComboBox returns a string with all subprop information, we need to parse it 
        'and update all properties
        Me.EmployeeIDIncludeLookup =  newData
      Case "FirstName"
        Me.FirstName =  newData
      Case "LastName"
        Me.LastName =  newData
      Case "TimeCardID"
        Me.TimeCardID =  newData
    End Select
  End If
End Sub  

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

    Case "DateEntered"
        Me.DateEntered =  newData
    Case "EmployeeID"
        'Why? ComboBox returns a string with all subprop information, we need to parse it 
        'and update all properties
        Me.EmployeeIDIncludeLookup =  newData
    Case "FirstName"
        Me.FirstName =  newData
    Case "LastName"
        Me.LastName =  newData
    Case "TimeCardID"
        Me.TimeCardID =  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