workcode.cls

人事档案管理系统(PB)/人事工资管理系统/干部信息管理系统/投标报价与合同管理系统/... 超市...

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

Attribute VB_Name = WorkCode
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 aWorkCode As WorkCode)
Public Event OnRecordMarkForDelete(byRef aWorkCode As WorkCode)
Public Event OnDirty(byVal IsDirty As Boolean)
Public Event OnRecordLoad(byRef aWorkCode As WorkCode)

Private WithEvents mobjValid As BrokenRules
Event Valid(ByVal IsValid As Boolean)
Private m_WorkCode As String
Private m_WorkCodeID As Long
Private m_OldWorkCodeID 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 OldWorkCodeID(vData As Long)
  m_OldWorkCodeID = vData
End Property

Public Property Let WorkCode (vData As String)
  m_WorkCode = vData 	
  IsDirty = True
End Property

Public Property Get WorkCode() As String
  WorkCode = m_WorkCode
End Property


Public Property Let WorkCodeID (vData As Long)
  m_WorkCodeID = vData 	
  IsDirty = True
End Property

Public Property Get WorkCodeID() As Long
  WorkCodeID = m_WorkCodeID
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_WorkCode = vbnullstring
  m_WorkCodeID = 0


  Set mobjValid = New BrokenRules
  ReSetBrokenRule True 
End Sub	


Public Sub ReSetBrokenRule(byval BrokenAll As boolean)  
End Sub


Private Sub Class_Initialize()
  Clear
  m_Fields = Array("WorkCode", "WorkCodeID")  
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 [Work Codes] a WHERE  a.WorkCodeID=" & m_OldWorkCodeID & ""
  adoRS.Open strSQL , Conn, adOpenKeyset, adLockOptimistic
  With adoRS
  If Not .EOF Then
    If m_IsDeleted Then
      .Delete
    Else	
SaveRecord:
      adoRS("WorkCode") = IIF(m_WorkCode= vbNullString, vbNullString, m_WorkCode)

      .Update
      m_WorkCodeID = adoRS("WorkCodeID")
      m_OldWorkCodeID = m_WorkCodeID
    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,"WorkCode","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()

  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 [Work Codes] " & strDeleteSQL 
  Conn.Execute strSQL
  DeleteList = True
  
  Exit Function
Err_DeleteList:
  ErrNum = Err.Number
  ErrMsg = Err.Description
  Call ErrHandler(ErrNum, ErrMsg,"WorkCode","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 vWorkCodeID As Long) As Boolean
  On Error GoTo Err_Load

  Dim adoRS As New ADODB.Recordset
  Dim strSQL As String

  Clear

  strSQL = "Select a.WorkCode,a.WorkCodeID From [Work Codes] a WHERE a.WorkCodeID=" & vWorkCodeID & ""

  adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    
  With adoRS
    If Not .EOF Then
      m_WorkCode= IIF(IsNull(adoRS("WorkCode")), "", adoRS("WorkCode"))
      m_WorkCodeID= IIF(IsNull(adoRS("WorkCodeID")), 0, adoRS("WorkCodeID"))
      m_OldWorkCodeID = m_WorkCodeID

	  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,"WorkCode","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 WorkCodes object                  *
'******************************************************************************
Function LoadList(Optional ByVal SQLWhereClause As String = vbNullString , Optional GetChildren As Boolean = False) As WorkCodes
  On Error GoTo Err_LoadList
  Dim adoRS As New ADODB.Recordset
  Dim strSQL As String
  Dim uWorkCode As WorkCode
  Dim uWorkCodes As New WorkCodes

  strSQL = "Select a.WorkCode,a.WorkCodeID From [Work Codes] a" & SQLWhereClause

  adoRS.Open strSQL, Conn, adOpenForwardOnly, adLockReadOnly
    
  With adoRS
    Do While Not .EOF
      Set uWorkCode = Nothing
      Set uWorkCode = New WorkCode
      uWorkCode.WorkCode= IIF(IsNull(adoRS("WorkCode")), "", adoRS("WorkCode"))
      uWorkCode.WorkCodeID= IIF(IsNull(adoRS("WorkCodeID")), 0, adoRS("WorkCodeID"))
      uWorkCode.OldWorkCodeID = uWorkCode.WorkCodeID
	
      uWorkCode.IsDirty = False    
      uWorkCode.IsNew = False 
      uWorkCode.ReSetBrokenRule False
      uWorkCodes.AddExisting uWorkCode, ":" & uWorkCode.WorkCodeID 

      .MoveNext
    Loop
    .Close
  End With

  Set LoadList = uWorkCodes
  Exit Function

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



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

  uWorkCode.WorkCode = m_WorkCode
  uWorkCode.WorkCodeID = m_WorkCodeID
  uWorkCode.IsDirty = m_IsDirty
  uWorkCode.IsNew = m_IsNew
  uWorkCode.IsDeleted = m_IsDeleted
  uWorkCode.OldWorkCodeID = m_OldWorkCodeID
  Set CopyMe = uWorkCode
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 "WorkCode"
        Me.WorkCode =  newData
      Case "WorkCodeID"
        Me.WorkCodeID =  newData
    End Select
  End If
End Sub  

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

    Case "WorkCode"
        Me.WorkCode =  newData
    Case "WorkCodeID"
        Me.WorkCodeID =  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