clients.cls

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

VERSION 1.0 CLASS
Begin
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone  
  DataSourceBehavior = 0   'vbNone
  MTSTransactionMode = 0   'NotAnMTSObject
End
Attribute VB_Name = "Clients"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder", "Yes"
Attribute VB_Ext_KEY = "SavedWithClassBuilder6", "Yes"
Attribute VB_Ext_KEY = "SavedWithCOMExpress", "Yes"
Attribute VB_Ext_KEY = "Collection" ,"Client"
Attribute VB_Ext_KEY = "Member0" ,"Client"
Attribute VB_Ext_KEY = "Top_Level", "No"
Option Explicit  
Implements COMEXDataSource
Private m_Fields() 
Private mcol As Collection

Public Event OnRecordInsert(ByRef vClient As Client)

Public Property Get Item(vntIndexKey As Variant) As Client
Attribute Item.VB_UserMemId = 0
  On Error Resume Next
  Set Item = mCol(vntIndexKey)
  If Err.Number <> 0 Then
    Set Item = Nothing
  End If
End Property

Public Function Key(ByRef vClient As Client) As String
  Key = ":" & vClient.ClientID 
End Function

Public Property Get Count() As Long
  Count = mCol.Count
End Property

Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = "40"
  Set NewEnum = mCol.[_NewEnum]
End Property

Private Sub Class_Initialize()
  Set mCol = New Collection 
  m_Fields = Array("Address", "City", "ClientID", "CompanyName", "ContactFirstName", "ContactLastName", "ContactTitle", "Country", "FaxNumber", "Notes", "PhoneNumber", "PostalCode", "StateOrProvince")
End Sub

Private Sub Class_Terminate()
  Set mCol = Nothing
End Sub

Public Sub Remove(vntIndexKey As Variant)
  mCol.Remove vntIndexKey
End Sub

Public Sub Clear()
  Set mCol = Nothing
  Set mCol = New Collection
End Sub

Public Function AddExisting(vClient As Client, Optional sKey As String = vbNullString) As Boolean
  On Error GoTo Err_AddExisting
  If Len(sKey) = 0 Then
    mCol.Add vClient
  Else
    mCol.Add vClient, sKey
  End If
  AddExisting = True
  RaiseEvent OnRecordInsert(vClient)
  Exit Function
Err_AddExisting:
  AddExisting = False
End Function

Public Function Add(m_Address As String, m_City As String, m_ClientID As Long, m_CompanyName As String, m_ContactFirstName As String, m_ContactLastName As String, m_ContactTitle As String, m_Country As String, m_FaxNumber As String, m_Notes As String, m_PhoneNumber As String, m_PostalCode As String, m_StateOrProvince As String, m_ClientProjects As ClientProjects, Optional sKey As String = vbNullString) As Client
  Dim objNewMember As Client
  Set objNewMember = New Client
  objNewMember.Address = m_Address
  objNewMember.City = m_City
  objNewMember.ClientID = m_ClientID
  objNewMember.CompanyName = m_CompanyName
  objNewMember.ContactFirstName = m_ContactFirstName
  objNewMember.ContactLastName = m_ContactLastName
  objNewMember.ContactTitle = m_ContactTitle
  objNewMember.Country = m_Country
  objNewMember.FaxNumber = m_FaxNumber
  objNewMember.Notes = m_Notes
  objNewMember.PhoneNumber = m_PhoneNumber
  objNewMember.PostalCode = m_PostalCode
  objNewMember.StateOrProvince = m_StateOrProvince
  Set objNewMember.ClientProjects = m_ClientProjects

  If Len(sKey) = 0 Then
    mCol.Add objNewMember
  Else
    mCol.Add objNewMember, sKey
  End If
  Set Add = objNewMember
  RaiseEvent OnRecordInsert(objNewMember)
  Set objNewMember = Nothing
End Function

 

Private Function COMEXDataSource_GetData(ByVal Field As Long, ByVal Record As Long) As Variant 
  If Record > 0 And Record <= mcol.Count Then
    Dim vItem As COMEXDataSourceSingle
    Set vItem = mcol.Item(Record)
    COMEXDataSource_GetData = vItem.GetData(Field)
  Else
    COMEXDataSource_GetData = Null
  End If
End Function

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

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

Private Function COMEXDataSource_GetRecordCount() As Long
  COMEXDataSource_GetRecordCount = mcol.Count
End Function

Private Sub COMEXDataSource_SetData(ByVal Field As Long, ByVal Record As Long, ByVal newData As Variant)
  Dim vItem As COMEXDataSourceSingle
  If Record > 0 And Record <= mcol.Count  Then    
    Set vItem = mcol.Item(Record)
    vItem.SetData Field, newData 
  ElseIf Record = mcol.count + 1 Then
    Set vItem = New Client
    vItem.SetData Field, newData 
    mcol.Add vItem    
  End If
End Sub 

Private Sub COMEXDataSource_Delete(ByVal Record As Long)
  If Record > 0 And Record <= mcol.Count Then mcol.Item(Record).Delete  
End Sub

Private Function COMEXDataSource_Save() As Boolean
  Dim vItem As Client, i As long, bolRet As Boolean  
  i = 1
  Do While i <= mcol.count
    Set vItem = mcol.Item(i)    
    If Not (vItem.IsNew and vItem.IsDeleted) Then 
      bolRet = vItem.Save
      If Not bolRet Then 
        COMEXDataSource_Save = False
        Exit Function
      End If                
      i = i + 1
    Else
      mcol.remove i
    End If
  Loop
  COMEXDataSource_Save = True  
End Function 

Private Property Get COMEXDataSource_IsDeleted(ByVal Record As Long) As Boolean
  If Record > 0 And Record <= mcol.Count Then  _
    COMEXDataSource_IsDeleted = Item(Record).IsDeleted
End Property