rsclsaddlock.cls

这是一个银行IC卡门禁系统软件

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 1  'vbDataSource
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "rsclsAddLock"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Public SaveMode As EnumSaveMode

'##ModelId=3D33843400FB
Private WithEvents rs As Recordset
Attribute rs.VB_VarHelpID = -1
'##ModelId=3D338432024C
Private vPKValues() As Variant

'##ModelId=3D33843300C8
Private TRS As New ADODB.Recordset

'##ModelId=3D3384330135
Private mbDataInitialized As Boolean
'##ModelId=3D3384330185
Private mbAddingRecord As Boolean
'##ModelId=3D33843301E9
Private mbDeleteInProgress As Boolean

'##ModelId=3D3384330243
Private bInitComplete As Boolean
'##ModelId=3D3384370311
Public Event rsMoveComplete()
'##ModelId=3D3384370357
Public Event DeleteRecordComplete()
'##ModelId=3D33843703BB
Public Event rsUpdateEvent(vFieldName As Variant)

'##ModelId=3D33843600D5
Public Property Let AbsolutePosition(lAbsolutePosition As Long)

    rs.AbsolutePosition = lAbsolutePosition

End Property

'##ModelId=3D3384360139
Public Property Get AbsolutePosition() As Long

    AbsolutePosition = rs.AbsolutePosition

End Property

'##ModelId=3D338436017F
Public Property Get BOF() As Boolean

    BOF = rs.BOF

End Property

'##ModelId=3D33843601BB
Public Property Get EOF() As Boolean

    EOF = rs.EOF

End Property

'##ModelId=3D3384360201
Public Function returnRecordset() As ADODB.Recordset

    Set returnRecordset = rs

End Function

'##ModelId=3D3384360233
Public Sub Refresh()

    rs.Requery

End Sub

'##ModelId=3D338436025B
Private Sub Class_GetDataMember(DataMember As String, Data As Object)

    On Error GoTo EmployeeGetDateMemberErr

    bInitComplete = False

    Select Case LCase(DataMember)

        Case "":

            With TRS

                .CursorLocation = adUseClient
                .CursorType = adOpenKeyset

                If SaveMode = adImmediate Then

                    .LockType = adLockOptimistic

                Else

                    .LockType = adLockBatchOptimistic

                End If
            
                If Not cnnLock.State = adStateOpen Then

                    cnnLock.Open

                End If
                
                .Open "select * from AddLock order by LockArea", cnnLock, adOpenDynamic

            End With


            Set rs = TRS
            
            Set Data = TRS
    
        Case "new":

            With TRS

                .CursorLocation = adUseClient
                .CursorType = adOpenKeyset

                If SaveMode = adImmediate Then

                    .LockType = adLockOptimistic

                Else

                    .LockType = adLockBatchOptimistic

                End If
            
                If Not cnnLock.State = adStateOpen Then

                    cnnLock.Open

                End If
                
                .Open "select * from AddLock where ID=0", cnnLock, adOpenDynamic

            End With


            Set rs = TRS
            
            Set Data = TRS
    End Select

    bInitComplete = True

    Exit Sub
EmployeeGetDateMemberErr:
    Err.Raise Err.Number, Err.Description & vbCrLf & "LockToday.GetDataMember", Err.Source

End Sub

'##ModelId=3D33843602E8
Private Sub Class_Initialize()

    mbDataInitialized = False

End Sub

'##ModelId=3D3384360310
Private Sub Class_Terminate()

    Set TRS = Nothing
    Set rs = Nothing

End Sub

'##ModelId=3D338436034C
Public Sub Move(lRows As Long)

    On Error GoTo errMove:

    rs.Move lRows

    Exit Sub
errMove:

End Sub

'##ModelId=3D338436039C
Public Sub MoveNext()

    If (rs.RecordCount > 0) And (Not rs.EOF) Then

        rs.MoveNext

    End If

End Sub

'##ModelId=3D33843603CE
Public Sub MoveFirst()

    If rs.RecordCount > 0 Then

        rs.MoveFirst

    End If

End Sub

'##ModelId=3D3384370018
Public Sub MovePrevious()

    If (rs.RecordCount > 0) And (Not rs.BOF) Then

        rs.MovePrevious

    End If

End Sub

'##ModelId=3D3384370040
Public Sub MoveLast()

    If rs.RecordCount > 0 Then

        rs.MoveLast

    End If

End Sub

'##ModelId=3D3384370072
Private Sub RS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)

    If rs.BOF Then

        Exit Sub

    End If

    If rs.EOF Then

        Exit Sub

    End If

    RaiseEvent rsMoveComplete

End Sub

'##ModelId=3D33843701DB
Public Sub UpdateBatch()

    On Error GoTo EmployeeUpdateError

    rs.UpdateBatch

    If mbAddingRecord = True Then

        mbAddingRecord = False
        Me.MoveLast

    End If

    Exit Sub

EmployeeUpdateError:
    Err.Raise Err.Number, Err.Description & vbCrLf & "Employee.UpdateBatch", Err.Source

End Sub

'##ModelId=3D338437020D
Public Sub Update()

    On Error GoTo EmployeeUpdateErr

    rs.UpdateBatch adAffectCurrent
    
    If mbAddingRecord = True Then

        mbAddingRecord = False
        Me.MoveLast

    End If

    Exit Sub

EmployeeUpdateErr:
    Err.Raise Err.Number, Err.Description & vbCrLf & "Employee.Update", Err.Source

End Sub

'##ModelId=3D338437023F
Public Sub AddRecord()

    On Error GoTo EmployeeAddrecordErr

    If mbAddingRecord = True Then

        Exit Sub

    End If
    
    With rs

        .AddNew

    End With

    mbAddingRecord = True
    Exit Sub

EmployeeAddrecordErr:
    Err.Raise Err.Number, Err.Description & vbCrLf & "Employee.Addrecord", Err.Source

End Sub

'##ModelId=3D3384370267
Public Sub rsUpdate(vFieldName As Variant)

    RaiseEvent rsUpdateEvent(vFieldName)

End Sub

'##ModelId=3D33843702B7
Public Sub Delete()

    On Error GoTo EmployeeDeleteErr

    If mbAddingRecord = True Then

        Exit Sub

    End If
    
    rs.Delete adAffectCurrent
    Me.MovePrevious
    Exit Sub

EmployeeDeleteErr:
    Err.Raise Err.Number, Err.Description & vbCrLf & "Employee.Delete", Err.Source

End Sub

'##ModelId=3D33843702E9
Public Sub CancelUpdate()

    On Error GoTo EmployeeCancelUpdateErr

    If mbAddingRecord = True Then

        If Me.SaveMode = adBatch Then

            rs.CancelBatch adAffectCurrent
            mbAddingRecord = False

        ElseIf Me.SaveMode = adImmediate Then

            rs.CancelUpdate
            mbAddingRecord = False

        End If

    End If

    Exit Sub

EmployeeCancelUpdateErr:
    Err.Raise Err.Number, Err.Description & vbCrLf & "Employee.CancelUpdate", Err.Source

End Sub

Public Property Get RecordCount() As Long

    RecordCount = rs.RecordCount

End Property

Public Property Let ID(newID As Variant)
    If IsNull(newID) Then
       rs("ID") = Null
    Else
       rs("ID") = newID
    End If
End Property

Public Property Get ID() As Variant
    ID = rs("ID")
End Property

Public Property Let LockID(newLockID As Variant)
    If IsNull(newLockID) Then
       rs("LockID") = Null
    Else
       rs("LockID") = newLockID
    End If
End Property

Public Property Get LockID() As Variant
    LockID = rs("LockID")
End Property

Public Property Let LockNO(newLockNO As Variant)
    If IsNull(newLockNO) Then
       rs("LockNO") = Null
    Else
       rs("LockNO") = newLockNO
    End If
End Property

Public Property Get LockNO() As Variant
    LockNO = rs("LockNO")
End Property

Public Property Let LockArea(newLockArea As Variant)
    If IsNull(newLockArea) Then
       rs("LockArea") = Null
    Else
       rs("LockArea") = newLockArea
    End If
End Property

Public Property Get LockArea() As Variant
    LockArea = rs("LockArea")
End Property

Public Property Let UserID(newUserID As Variant)
    If IsNull(newUserID) Then
       rs("UserID") = Null
    Else
       rs("UserID") = newUserID
    End If
End Property

Public Property Get UserID() As Variant
    UserID = rs("UserID")
End Property

Public Property Let UserName(newUserName As Variant)
    If IsNull(newUserName) Then
       rs("UserName") = Null
    Else
       rs("UserName") = newUserName
    End If
End Property

Public Property Get UserName() As Variant
    UserName = rs("UserName")
End Property

Public Function FindLockNO(ByVal Key As String) As Boolean
    
    With rs

        If .BOF And .EOF Then

            FindLockNO = False
            Exit Function

        End If
        
        .MoveFirst
        .Find "LockNO='" & Key & "'", 0, adSearchForward
        
        If .EOF Then

            FindLockNO = False

        Else

            FindLockNO = True

        End If
        
    End With

End Function