paymentmethod.cls

VB中实现3层结构的完整教学示例（很难得的）

VERSION 1.0 CLASS
Begin      
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
End    

Attribute VB_Name = PaymentMethod
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Implements COMEXDataSourceSingle      
Private m_Fields() 
Public Event OnRecordSaved(byRef aPaymentMethod As PaymentMethod)
Public Event OnRecordMarkForDelete(byRef aPaymentMethod As PaymentMethod)
Public Event OnDirty(byVal IsDirty As Boolean)
Public Event OnRecordLoad(byRef aPaymentMethod As PaymentMethod)

Private WithEvents mobjValid As BrokenRules
Event Valid(ByVal IsValid As Boolean)
Private m_CreditCard As Boolean
Private m_PaymentMethod As String
Private m_PaymentMethodID As Long
Private m_OldPaymentMethodID As Long
Private m_IsNew As Boolean
Private m_IsDirty As Boolean
Private m_IsDeleted As Boolean
	      

Friend Property Let IsNew(Byval vData As boolean)
  m_IsNew = vData
End Property

Public Property Get IsNew() As Boolean
  IsNew = m_IsNew
End Property

Friend Property Let IsDirty(Byval vData As boolean)
  m_IsDirty = vData
  RaiseEvent OnDirty(vData)
End Property

Public Property Get IsDirty() As Boolean
  IsDirty = m_IsDirty
End Property

Friend Property Let IsDeleted(Byval vData As boolean)
  m_IsDeleted = vData
  RaiseEvent OnRecordMarkForDelete(Me) 
End Property

Public Property Get IsDeleted() As Boolean
  IsDeleted = m_IsDeleted
End Property    

Public Property Get IsValid() As Boolean
  IsValid = (mobjValid.Count = 0)
End Property

Private Sub mobjValid_BrokenRule()
  RaiseEvent Valid(False)
End Sub

Private Sub mobjValid_NoBrokenRules()
  RaiseEvent Valid(True)
End Sub
'******************************************************************************
'Begin property get/let/set                                                   *
'******************************************************************************

Friend Property Let OldPaymentMethodID(vData As Long)
  m_OldPaymentMethodID = vData
End Property

Public Property Let CreditCard (vData As Boolean)
  m_CreditCard = vData 
  mobjValid.RuleBroken "CreditCard", False	
  IsDirty = True
End Property

Public Property Get CreditCard() As Boolean
  CreditCard = m_CreditCard
End Property


Public Property Let PaymentMethod (vData As String)
  m_PaymentMethod = vData 	
  IsDirty = True
End Property

Public Property Get PaymentMethod() As String
  PaymentMethod = m_PaymentMethod
End Property


Public Property Let PaymentMethodID (vData As Long)
  m_PaymentMethodID = vData 	
  IsDirty = True
End Property

Public Property Get PaymentMethodID() As Long
  PaymentMethodID = m_PaymentMethodID
End Property


'******************************************************************************
'End property get/let/set                                                     *
'******************************************************************************	

'******************************************************************************
'*                                                                            *
'* Name:    Clear                                                             *
'*                                                                            *
'* Purpose: Reset this object and initialize data to default.                 *
'*                                                                            *
'******************************************************************************
Public Sub Clear() 
  m_IsNew = True
  m_IsDirty = False
  m_IsDeleted = False 

  m_CreditCard = 0
  m_PaymentMethod = vbnullstring
  m_PaymentMethodID = 0


  Set mobjValid = New BrokenRules
  ReSetBrokenRule True 
End Sub	


Public Sub ReSetBrokenRule(byval BrokenAll As boolean)  
  mobjValid.RuleBroken "CreditCard", BrokenAll
End Sub


Private Sub Class_Initialize()
  Clear
  m_Fields = Array("CreditCard", "PaymentMethod", "PaymentMethodID")  
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 [Payment Methods] a WHERE  a.PaymentMethodID=" & m_OldPaymentMethodID & ""
  adoRS.Open strSQL , Conn, adOpenKeyset, adLockOptimistic
  With adoRS
  If Not .EOF Then
    If m_IsDeleted Then
      .Delete
    Else	
SaveRecord:
      adoRS("CreditCard") = m_CreditCard
      adoRS("PaymentMethod") = IIF(m_PaymentMethod= vbNullString, vbNullString, m_PaymentMethod)

      .Update
      m_PaymentMethodID = adoRS("PaymentMethodID")
      m_OldPaymentMethodID = m_PaymentMethodID
    End If
  Else
    If Not m_IsDeleted Then
      .AddNew
      GoTo SaveRecord
    End If
  End If
  .Close
  End With

Skip_Save:

  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,"PaymentMethod","Save")
  GoTo Done_Save
Rollback_Save:
  If bolInTran Then Conn.RollbackTrans
  Return
End Function
'******************************************************************************
'*                                                                            *