VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CRecord"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Private mstrField  As Variant
Private mlngKeyCount As Long

Private mbIsDataAdded As Boolean
Private mCurPosition As Integer

Private mvarData As Variant
Private mstrTableName As String
Private mstrKeyField  As Variant

Private mlngErrNo  As Long
Private mstrErrDescription As String

Private mAdoConn As ADODB.Connection

'******************************************************************************
'目的：     取得活動(dòng)連接
'輸入：
'返回：     錯(cuò)誤號(hào)
'******************************************************************************
Public Property Let DBConnect(ByRef AdoConn As ADODB.Connection)
    Set mAdoConn = AdoConn
End Property

'******************************************************************************
'目的：     取得當(dāng)前錯(cuò)誤號(hào)
'輸入：
'返回：     錯(cuò)誤號(hào)
'******************************************************************************
Public Property Get ErrNo() As Long
    ErrNo = mlngErrNo
    
End Property


'******************************************************************************
'目的：     取得當(dāng)前錯(cuò)誤描述
'輸入：
'返回：     錯(cuò)誤描述
'******************************************************************************
Public Property Get ErrDescription() As String
    ErrDescription = mstrErrDescription
End Property

'******************************************************************************
'目的：取得字段名稱(chēng)
'輸入：字段順序號(hào)
'返回：字段名
'******************************************************************************

Public Property Get FieldName(ByVal Item As Long) As String
    On Error Resume Next
    
    If Not IsArray(mstrField) Then Exit Property
    If UBound(mstrField) >= Val(Item) Then
        FieldName = mstrField(Val(Item))
    End If
End Property

'******************************************************************************
'目的：得到當(dāng)前記錄某字段值
'輸入：字段名稱(chēng)或編號(hào)
'返回：當(dāng)前記錄某字段值
'******************************************************************************

Public Property Get Value(ByVal Field As Variant) As Variant
    On Error Resume Next
    
    If IsNumeric(Field) Then Field = Val(Field) + 1
    Value = mvarData(mCurPosition)(Field)
End Property

'******************************************************************************
'目的：設(shè)置/修改當(dāng)前記錄某字段值
'輸入：字段名稱(chēng)或編號(hào)，要設(shè)置的值
'返回：
'******************************************************************************

Public Property Let Value(ByVal Field As Variant, ByVal varValue As Variant)
    On Error GoTo E
    Dim i As Integer, varTemp As Variant, sFieldName As String, lngItem As Long
    If IsArray(mstrField) Then
        If mbIsDataAdded Then
'            AddValue = False
            mlngErrNo = -1
            mstrErrDescription = "不允許在AddValue之后再修改字段信息。"
            Exit Property
        Else
            If UBound(mstrField) = 0 Then
'                AddValue = False
                mlngErrNo = -1
                mstrErrDescription = "不允許保存只有一個(gè)字段的結(jié)果。"
                Exit Property
            End If
        End If
    Else
'        AddValue = False
        mlngErrNo = -1
        mstrErrDescription = "請(qǐng)先使用AddField添加兩個(gè)或兩個(gè)以上字段。"
        Exit Property
    End If
    If Not IsNumeric(Field) Then
        If CheckField(Field) Then
            sFieldName = Field
        End If
    Else
        sFieldName = Item2Name(Val(Field))
    End If
    
    If sFieldName <> "" Then
        On Error Resume Next
        mvarData(mCurPosition).Remove sFieldName
        On Error GoTo E
        mvarData(mCurPosition).Add varValue, sFieldName
    Else
        Resume InvalidField
    End If
        
ExitEntry:
    mbIsDataAdded = True
    mstrErrDescription = ""
    mlngErrNo = 0
    Exit Property
InvalidField:
    mstrErrDescription = "無(wú)效的字段。"
    mlngErrNo = -1
    Exit Property
E:
    mlngErrNo = Err.Number
    mstrErrDescription = Err.Description
End Property

'******************************************************************************
'目的：添加一個(gè)字段
'輸入：字段名稱(chēng)
'返回：成功/失敗
'******************************************************************************

Public Function AddField(ByVal strFieldName As String) As Boolean
    On Error GoTo E
    If mbIsDataAdded Then
        AddField = False
        mlngErrNo = -1
        mstrErrDescription = "不允許在AddValue之后再修改字段信息。"
        Exit Function
    End If
    
    If IsArray(mstrField) Then
        ReDim Preserve mstrField(UBound(mstrField) + 1) As String
    Else
        ReDim mstrField(0) As String
    End If
    
    mstrField(UBound(mstrField)) = strFieldName
ExitEntry:
    AddField = True
    mstrErrDescription = ""
    mlngErrNo = 0
    Exit Function
E:
    AddField = False
    mlngErrNo = Err.Number
    mstrErrDescription = Err.Description
End Function

'******************************************************************************
'目的：移動(dòng)到下一條記錄(記錄為空時(shí)不可移動(dòng))
'輸入：
'返回：成功/失敗
'******************************************************************************

Public Function MoveNext() As Boolean
    On Error GoTo E
    
    If Not IsArray(mvarData) Then Resume ErrOut
    
    If UBound(mvarData) >= 0 Then
        If mCurPosition + 1 <= UBound(mvarData) Then
            mCurPosition = mCurPosition + 1
        Else
            mCurPosition = 0
        End If
    Else
        Resume ErrOut
    End If

ExitEntry:
    MoveNext = True
    mstrErrDescription = ""
    mlngErrNo = 0
    Exit Function

ErrOut:
    mlngErrNo = -1
    mstrErrDescription = "目前記錄為空，無(wú)法移動(dòng)！"
    Exit Function

E:
    MoveNext = False
    mlngErrNo = Err.Number
    mstrErrDescription = Err.Description
End Function

'******************************************************************************
'目的：新增加一條記錄
'輸入：
'返回：成功/失敗
'******************************************************************************

Public Function AddNew() As Boolean
    On Error GoTo E
    If IsArray(mvarData) Then
        ReDim Preserve mvarData(UBound(mvarData) + 1) As Variant
        Set mvarData(UBound(mvarData)) = New Collection
        mCurPosition = UBound(mvarData)
    Else
        ReDim mvarData(0) As Variant
        Set mvarData(0) = New Collection
        mCurPosition = 0
    End If
ExitEntry:
    AddNew = True
    mlngErrNo = 0
    mstrErrDescription = ""
    Exit Function
E:
    AddNew = False
    mlngErrNo = Err.Number
    mstrErrDescription = Err.Description
    
End Function


'******************************************************************************
'目的：移動(dòng)記錄到第一條
'輸入：
'返回：成功/失敗
'******************************************************************************


Public Function MoveFirst() As Boolean
    On Error GoTo E
    
    If Not IsArray(mvarData) Then Resume ErrOut
    
    If UBound(mvarData) >= 0 Then
        mCurPosition = 0
    Else
        Resume ErrOut
    End If

ExitEntry:
    MoveFirst = True
    mstrErrDescription = ""
    mlngErrNo = 0
    Exit Function

ErrOut:
    MoveFirst = False
    mlngErrNo = -1
    mstrErrDescription = "目前記錄為空，無(wú)法移動(dòng)！"
    Exit Function

E:
    MoveFirst = False
    mlngErrNo = Err.Number
    mstrErrDescription = Err.Description
End Function

'******************************************************************************
'目的：移動(dòng)到某條記錄
'輸入：指定的記錄
'返回：成功/失敗
'******************************************************************************

Public Function Move(ByVal lngPostion As Long) As Boolean
    On Error GoTo E
    
    If Not IsArray(mvarData) Then Resume ErrOut
    
    If UBound(mvarData) >= 0 Then
        If lngPostion <= UBound(mvarData) Then
            mCurPosition = lngPostion
        Else
            Resume OutSpace
        End If
    Else