timecardhour.cls

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

'*                                                                            *
'* 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 Card Hours] " & strDeleteSQL 
  Conn.Execute strSQL
  DeleteList = True
  
  Exit Function
Err_DeleteList:
  ErrNum = Err.Number
  ErrMsg = Err.Description
  Call ErrHandler(ErrNum, ErrMsg,"TimeCardHour","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 vTimeCardDetailID As Long) As Boolean
  On Error GoTo Err_Load

  Dim adoRS As New ADODB.Recordset
  Dim strSQL As String

  Clear

  strSQL = "Select a.BillableHours,a.BillingRate,a.ProjectID,b.ProjectName As ProjectName,a.TimeCardDetailID,a.TimeCardID,c.DateEntered As DateEntered,a.WorkCodeID,d.WorkCode As WorkCode,a.WorkDescription,a.DateWorked From (([Time Card Hours] a LEFT JOIN Projects b ON a.ProjectID = b.ProjectID) RIGHT JOIN [Time Cards] c ON a.TimeCardID = c.TimeCardID) LEFT JOIN [Work Codes] d ON a.WorkCodeID = d.WorkCodeID WHERE a.TimeCardDetailID=" & vTimeCardDetailID & ""

  adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    
  With adoRS
    If Not .EOF Then
      m_BillableHours= IIF(IsNull(adoRS("BillableHours")), 0, adoRS("BillableHours"))
      m_BillingRate= IIF(IsNull(adoRS("BillingRate")), 0, adoRS("BillingRate"))
      m_ProjectID= IIF(IsNull(adoRS("ProjectID")), 0, adoRS("ProjectID"))
      m_ProjectName= IIF(IsNull(adoRS("ProjectName")), "", adoRS("ProjectName"))
      m_TimeCardDetailID= IIF(IsNull(adoRS("TimeCardDetailID")), 0, adoRS("TimeCardDetailID"))
      m_TimeCardID= IIF(IsNull(adoRS("TimeCardID")), 0, adoRS("TimeCardID"))
      m_DateEntered= IIF(IsNull(adoRS("DateEntered")), "12:00:00AM", adoRS("DateEntered"))
      m_WorkCodeID= IIF(IsNull(adoRS("WorkCodeID")), 0, adoRS("WorkCodeID"))
      m_WorkCode= IIF(IsNull(adoRS("WorkCode")), "", adoRS("WorkCode"))
      m_WorkDescription= IIF(IsNull(adoRS("WorkDescription")), "", adoRS("WorkDescription"))
      m_DateWorked= IIF(IsNull(adoRS("DateWorked")), "12:00:00AM", adoRS("DateWorked"))
      m_OldTimeCardDetailID = m_TimeCardDetailID

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


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

Err_Load:
  ErrNum = Err.Number
  ErrMsg = Err.Description
  Call ErrHandler(ErrNum, ErrMsg,"TimeCardHour","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 TimeCardHours object                  *
'******************************************************************************
Function LoadList(Optional ByVal SQLWhereClause As String = vbNullString , Optional GetChildren As Boolean = False) As TimeCardHours
  On Error GoTo Err_LoadList
  Dim adoRS As New ADODB.Recordset
  Dim strSQL As String
  Dim uTimeCardHour As TimeCardHour
  Dim uTimeCardHours As New TimeCardHours

  strSQL = "Select a.BillableHours,a.BillingRate,a.ProjectID,b.ProjectName As ProjectName,a.TimeCardDetailID,a.TimeCardID,c.DateEntered As DateEntered,a.WorkCodeID,d.WorkCode As WorkCode,a.WorkDescription,a.DateWorked From (([Time Card Hours] a LEFT JOIN Projects b ON a.ProjectID = b.ProjectID) RIGHT JOIN [Time Cards] c ON a.TimeCardID = c.TimeCardID) LEFT JOIN [Work Codes] d ON a.WorkCodeID = d.WorkCodeID" & SQLWhereClause

  adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    
  With adoRS
    Do While Not .EOF
      Set uTimeCardHour = Nothing
      Set uTimeCardHour = New TimeCardHour
      uTimeCardHour.BillableHours= IIF(IsNull(adoRS("BillableHours")), 0, adoRS("BillableHours"))
      uTimeCardHour.BillingRate= IIF(IsNull(adoRS("BillingRate")), 0, adoRS("BillingRate"))
      uTimeCardHour.ProjectID= IIF(IsNull(adoRS("ProjectID")), 0, adoRS("ProjectID"))
      uTimeCardHour.ProjectName= IIF(IsNull(adoRS("ProjectName")), "", adoRS("ProjectName"))
      uTimeCardHour.TimeCardDetailID= IIF(IsNull(adoRS("TimeCardDetailID")), 0, adoRS("TimeCardDetailID"))
      uTimeCardHour.TimeCardID= IIF(IsNull(adoRS("TimeCardID")), 0, adoRS("TimeCardID"))
      uTimeCardHour.DateEntered= IIF(IsNull(adoRS("DateEntered")), "12:00:00AM", adoRS("DateEntered"))
      uTimeCardHour.WorkCodeID= IIF(IsNull(adoRS("WorkCodeID")), 0, adoRS("WorkCodeID"))
      uTimeCardHour.WorkCode= IIF(IsNull(adoRS("WorkCode")), "", adoRS("WorkCode"))
      uTimeCardHour.WorkDescription= IIF(IsNull(adoRS("WorkDescription")), "", adoRS("WorkDescription"))
      uTimeCardHour.DateWorked= IIF(IsNull(adoRS("DateWorked")), "12:00:00AM", adoRS("DateWorked"))
      uTimeCardHour.OldTimeCardDetailID = uTimeCardHour.TimeCardDetailID
	
      uTimeCardHour.IsDirty = False    
      uTimeCardHour.IsNew = False 
      uTimeCardHour.ReSetBrokenRule False
      uTimeCardHours.AddExisting uTimeCardHour, ":" & uTimeCardHour.TimeCardDetailID 

      .MoveNext
    Loop
    .Close
  End With

  Set LoadList = uTimeCardHours
  Exit Function

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



'******************************************************************************
'*                                                                            *
'* Name:    GetProjectsList()                                                  *
'*                                                                            *
'* 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 GetProjectsList(Optional ColDelimeter As string = vbTab, Optional RowDelimeter As string = "|") As String
  Dim adoRs As New ADODB.Recordset
  Dim strSQL As string

  strSQL = "Select ProjectID,ProjectName from [Projects]"
  With adoRs
    .Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    If Not .EOF Then
      GetProjectsList = _
        adoRs.GetString(adClipString, , vbTab, "|", vbNullString)
    Else
      GetProjectsList = vbNullString 
    End If
    .Close
  End With
End Function

'******************************************************************************
'*                                                                            *
'* Name:    GetTime CardsList()                                                  *
'*                                                                            *
'* 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 GetTimeCardsList(Optional ColDelimeter As string = vbTab, Optional RowDelimeter As string = "|") As String
  Dim adoRs As New ADODB.Recordset
  Dim strSQL As string

  strSQL = "Select TimeCardID,DateEntered from [Time Cards]"
  With adoRs
    .Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    If Not .EOF Then
      GetTimeCardsList = _
        adoRs.GetString(adClipString, , vbTab, "|", vbNullString)
    Else
      GetTimeCardsList = vbNullString 
    End If
    .Close
  End With
End Function

'******************************************************************************
'*                                                                            *
'* Name:    GetWork CodesList()                                                  *
'*                                                                            *
'* 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 GetWorkCodesList(Optional ColDelimeter As string = vbTab, Optional RowDelimeter As string = "|") As String
  Dim adoRs As New ADODB.Recordset
  Dim strSQL As string

  strSQL = "Select WorkCodeID,WorkCode from [Work Codes]"
  With adoRs
    .Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    If Not .EOF Then
      GetWorkCodesList = _
        adoRs.GetString(adClipString, , vbTab, "|", vbNullString)
    Else
      GetWorkCodesList = vbNullString 
    End If
    .Close
  End With
End Function

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

  uTimeCardHour.BillableHours = m_BillableHours
  uTimeCardHour.BillingRate = m_BillingRate
  uTimeCardHour.ProjectID = m_ProjectID
  uTimeCardHour.ProjectName = m_ProjectName
  uTimeCardHour.TimeCardDetailID = m_TimeCardDetailID
  uTimeCardHour.TimeCardID = m_TimeCardID
  uTimeCardHour.DateEntered = m_DateEntered
  uTimeCardHour.WorkCodeID = m_WorkCodeID
  uTimeCardHour.WorkCode = m_WorkCode
  uTimeCardHour.WorkDescription = m_WorkDescription
  uTimeCardHour.DateWorked = m_DateWorked
  uTimeCardHour.IsDirty = m_IsDirty
  uTimeCardHour.IsNew = m_IsNew
  uTimeCardHour.IsDeleted = m_IsDeleted
  uTimeCardHour.OldTimeCardDetailID = m_OldTimeCardDetailID
  Set CopyMe = uTimeCardHour
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 "BillableHours"
        Me.BillableHours =  newData
      Case "BillingRate"
        Me.BillingRate =  newData
      Case "ProjectID"
        'Why? ComboBox returns a string with all subprop information, we need to parse it 
        'and update all properties
        Me.ProjectIDIncludeLookup =  newData
      Case "ProjectName"
        Me.ProjectName =  newData
      Case "TimeCardDetailID"
        Me.TimeCardDetailID =  newData
      Case "TimeCardID"
        'Why? ComboBox returns a string with all subprop information, we need to parse it 
        'and update all properties
        Me.TimeCardIDIncludeLookup =  newData
      Case "DateEntered"
        Me.DateEntered =  newData
      Case "WorkCodeID"
        'Why? ComboBox returns a string with all subprop information, we need to parse it 
        'and update all properties
        Me.WorkCodeIDIncludeLookup =  newData
      Case "WorkCode"
        Me.WorkCode =  newData
      Case "WorkDescription"
        Me.WorkDescription =  newData
      Case "DateWorked"
        Me.DateWorked =  newData
    End Select
  End If
End Sub  

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

    Case "BillableHours"
        Me.BillableHours =  newData
    Case "BillingRate"
        Me.BillingRate =  newData
    Case "ProjectID"
        'Why? ComboBox returns a string with all subprop information, we need to parse it 
        'and update all properties
        Me.ProjectIDIncludeLookup =  newData
    Case "ProjectName"
        Me.ProjectName =  newData
    Case "TimeCardDetailID"
        Me.TimeCardDetailID =  newData
    Case "TimeCardID"
        'Why? ComboBox returns a string with all subprop information, we need to parse it 
        'and update all properties
        Me.TimeCardIDIncludeLookup =  newData
    Case "DateEntered"
        Me.DateEntered =  newData
    Case "WorkCodeID"
        'Why? ComboBox returns a string with all subprop information, we need to parse it 
        'and update all properties
        Me.WorkCodeIDIncludeLookup =  newData
    Case "WorkCode"
        Me.WorkCode =  newData
    Case "WorkDescription"
        Me.WorkDescription =  newData
    Case "DateWorked"
        Me.DateWorked =  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