clientproject.cls

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

Private Sub Class_Initialize()
  Clear
  m_Fields = Array("ClientID", "EmployeeID", "ProjectDescription", "ProjectEndDate", "ProjectID", "ProjectName", "ProjectTotalBillingEstimate", "PurchaseOrderNumber", "ProjectBeginDate")  
End Sub
Private Sub Class_Terminate()
  Clear
End Sub

'******************************************************************************
'*                                                                            *
'* Name:    Save                                                              *
'*                                                                            *
'* Purpose: Save a changed object or a new record into database.              *
'*                                                                            *
'* Returns: True when successfully saved, false when failed to save.          *
'*                                                                            *
'******************************************************************************
Public Function Save(optional Byval bolStartTran As boolean = True) As Boolean   
  Dim adoRS As ADODB.Recordset
  Dim strSQL As String
  Dim Count As Long, i As Long, bolInTran As boolean 
  
  On Error GoTo Err_Save
  
  If Not IsDirty Then GoTo Skip_Save
  
                 
  If Not IsValid Then 
    InvalidHandler(mobjValid.BrokenRules)
    GoTo Done_Save
  End If
  
  If bolStartTran Then 
    Conn.BeginTrans  
    bolInTran = True
  End If
  
  Set adoRS = New ADODB.Recordset  

  strSQL ="Select * FROM Projects a WHERE  a.ProjectID=" & m_OldProjectID & ""
  adoRS.Open strSQL , Conn, adOpenKeyset, adLockOptimistic
  With adoRS
  If Not .EOF Then
    If m_IsDeleted Then
      .Delete
    Else	
SaveRecord:
      adoRS("ClientID") = m_ClientID
      adoRS("EmployeeID") = m_EmployeeID
      adoRS("ProjectDescription") = IIF(m_ProjectDescription= vbNullString, vbNullString, m_ProjectDescription)
      adoRS("ProjectEndDate") = m_ProjectEndDate
      adoRS("ProjectName") = IIF(m_ProjectName= vbNullString, vbNullString, m_ProjectName)
      adoRS("ProjectTotalBillingEstimate") = m_ProjectTotalBillingEstimate
      adoRS("PurchaseOrderNumber") = IIF(m_PurchaseOrderNumber= vbNullString, vbNullString, m_PurchaseOrderNumber)
      adoRS("ProjectBeginDate") = m_ProjectBeginDate

      .Update
      m_ProjectID = adoRS("ProjectID")
      m_OldProjectID = m_ProjectID
    End If
  Else
    If Not m_IsDeleted Then
      .AddNew
      GoTo SaveRecord
    End If
  End If
  .Close
  End With

Skip_Save:

  Dim uProjTimeCardHour As ProjTimeCardHour  
  i = 1
  Do While i <= m_ProjTimeCardHours.Count
    Set uProjTimeCardHour = m_ProjTimeCardHours(i)
    If uProjTimeCardHour.IsDeleted Then
      If Not uProjTimeCardHour.Save(False) Then
        GoSub Rollback_Save
        Exit Function
      End If
      m_ProjTimeCardHours.Remove i
    Else
      If uProjTimeCardHour.IsDirty Then
        uProjTimeCardHour.ProjectID = m_ProjectID
      End If
      If Not uProjTimeCardHour.Save(False) Then
        GoSub Rollback_Save
        Exit Function
      End If  
      i = i + 1
    End If
  Loop

  Dim uProjTimeCardExpense As ProjTimeCardExpense  
  i = 1
  Do While i <= m_ProjTimeCardExpenses.Count
    Set uProjTimeCardExpense = m_ProjTimeCardExpenses(i)
    If uProjTimeCardExpense.IsDeleted Then
      If Not uProjTimeCardExpense.Save(False) Then
        GoSub Rollback_Save
        Exit Function
      End If
      m_ProjTimeCardExpenses.Remove i
    Else
      If uProjTimeCardExpense.IsDirty Then
        uProjTimeCardExpense.ProjectID = m_ProjectID
      End If
      If Not uProjTimeCardExpense.Save(False) Then
        GoSub Rollback_Save
        Exit Function
      End If  
      i = i + 1
    End If
  Loop

  Dim uPayment As Payment  
  i = 1
  Do While i <= m_Payments.Count
    Set uPayment = m_Payments(i)
    If uPayment.IsDeleted Then
      If Not uPayment.Save(False) Then
        GoSub Rollback_Save
        Exit Function
      End If
      m_Payments.Remove i
    Else
      If uPayment.IsDirty Then
        uPayment.ProjectID = m_ProjectID
      End If
      If Not uPayment.Save(False) Then
        GoSub Rollback_Save
        Exit Function
      End If  
      i = i + 1
    End If
  Loop

  If bolInTran Then 
    Conn.CommitTrans
    bolInTran = False
  End If
  Save = True
  IsDirty = False     
  IsNew = False
  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,"ClientProject","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_ProjTimeCardHours.Delete
  m_ProjTimeCardExpenses.Delete
  m_Payments.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 Projects " & strDeleteSQL 
  Conn.Execute strSQL
  DeleteList = True
  
  Exit Function
Err_DeleteList:
  ErrNum = Err.Number
  ErrMsg = Err.Description
  Call ErrHandler(ErrNum, ErrMsg,"ClientProject","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 vProjectID 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.ClientID,b.CompanyName As CompanyName,a.EmployeeID,c.FirstName As FirstName,c.LastName As LastName,a.ProjectDescription,a.ProjectEndDate,a.ProjectID,a.ProjectName,a.ProjectTotalBillingEstimate,a.PurchaseOrderNumber,a.ProjectBeginDate From (Projects a LEFT JOIN Clients b ON a.ClientID = b.ClientID) LEFT JOIN Employees c ON a.EmployeeID = c.EmployeeID WHERE a.ProjectID=" & vProjectID & ""

  adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    
  With adoRS
    If Not .EOF Then
      m_ClientID= IIF(IsNull(adoRS("ClientID")), 0, adoRS("ClientID"))
      m_CompanyName= IIF(IsNull(adoRS("CompanyName")), "", adoRS("CompanyName"))
      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_ProjectDescription= IIF(IsNull(adoRS("ProjectDescription")), "", adoRS("ProjectDescription"))
      m_ProjectEndDate = adoRS("ProjectEndDate")
      m_ProjectID= IIF(IsNull(adoRS("ProjectID")), 0, adoRS("ProjectID"))
      m_ProjectName= IIF(IsNull(adoRS("ProjectName")), "", adoRS("ProjectName"))
      m_ProjectTotalBillingEstimate= IIF(IsNull(adoRS("ProjectTotalBillingEstimate")), 0, adoRS("ProjectTotalBillingEstimate"))
      m_PurchaseOrderNumber= IIF(IsNull(adoRS("PurchaseOrderNumber")), "", adoRS("PurchaseOrderNumber"))
      m_ProjectBeginDate= IIF(IsNull(adoRS("ProjectBeginDate")), "12:00:00AM", adoRS("ProjectBeginDate"))
      m_OldProjectID = m_ProjectID

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

  If GetChildren Then m_ProjTimeCardHours.LoadRelated m_ProjectID
  If GetChildren Then m_ProjTimeCardExpenses.LoadRelated m_ProjectID
  If GetChildren Then m_Payments.LoadRelated m_ProjectID

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

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

  strSQL = "Select a.ClientID,b.CompanyName As CompanyName,a.EmployeeID,c.FirstName As FirstName,c.LastName As LastName,a.ProjectDescription,a.ProjectEndDate,a.ProjectID,a.ProjectName,a.ProjectTotalBillingEstimate,a.PurchaseOrderNumber,a.ProjectBeginDate From (Projects a LEFT JOIN Clients b ON a.ClientID = b.ClientID) LEFT JOIN Employees c ON a.EmployeeID = c.EmployeeID" & SQLWhereClause

  adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    
  With adoRS
    Do While Not .EOF
      Set uClientProject = Nothing
      Set uClientProject = New ClientProject
      uClientProject.ClientID= IIF(IsNull(adoRS("ClientID")), 0, adoRS("ClientID"))
      uClientProject.CompanyName= IIF(IsNull(adoRS("CompanyName")), "", adoRS("CompanyName"))
      uClientProject.EmployeeID= IIF(IsNull(adoRS("EmployeeID")), 0, adoRS("EmployeeID"))
      uClientProject.FirstName= IIF(IsNull(adoRS("FirstName")), "", adoRS("FirstName"))
      uClientProject.LastName= IIF(IsNull(adoRS("LastName")), "", adoRS("LastName"))
      uClientProject.ProjectDescription= IIF(IsNull(adoRS("ProjectDescription")), "", adoRS("ProjectDescription"))
      uClientProject.ProjectEndDate = adoRS("ProjectEndDate")
      uClientProject.ProjectID= IIF(IsNull(adoRS("ProjectID")), 0, adoRS("ProjectID"))
      uClientProject.ProjectName= IIF(IsNull(adoRS("ProjectName")), "", adoRS("ProjectName"))
      uClientProject.ProjectTotalBillingEstimate= IIF(IsNull(adoRS("ProjectTotalBillingEstimate")), 0, adoRS("ProjectTotalBillingEstimate"))
      uClientProject.PurchaseOrderNumber= IIF(IsNull(adoRS("PurchaseOrderNumber")), "", adoRS("PurchaseOrderNumber"))
      uClientProject.ProjectBeginDate= IIF(IsNull(adoRS("ProjectBeginDate")), "12:00:00AM", adoRS("ProjectBeginDate"))
      uClientProject.OldProjectID = uClientProject.ProjectID
	
      uClientProject.IsDirty = False    
      uClientProject.IsNew = False 
      uClientProject.ReSetBrokenRule False
      uClientProjects.AddExisting uClientProject, ":" & uClientProject.ProjectID 
      If GetChildren Then uClientProject.ProjTimeCardHours.LoadRelated uClientProject.ProjectID
      If GetChildren Then uClientProject.ProjTimeCardExpenses.LoadRelated uClientProject.ProjectID
      If GetChildren Then uClientProject.Payments.LoadRelated uClientProject.ProjectID