?? crecord.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 = "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
'******************************************************************************
'目的: 取得活動連接
'輸入:
'返回: 錯誤號
'******************************************************************************
Public Property Let DBConnect(ByRef AdoConn As ADODB.Connection)
Set mAdoConn = AdoConn
End Property
'******************************************************************************
'目的: 取得當前錯誤號
'輸入:
'返回: 錯誤號
'******************************************************************************
Public Property Get ErrNo() As Long
ErrNo = mlngErrNo
End Property
'******************************************************************************
'目的: 取得當前錯誤描述
'輸入:
'返回: 錯誤描述
'******************************************************************************
Public Property Get ErrDescription() As String
ErrDescription = mstrErrDescription
End Property
'******************************************************************************
'目的:取得字段名稱
'輸入:字段順序號
'返回:字段名
'******************************************************************************
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
'******************************************************************************
'目的:得到當前記錄某字段值
'輸入:字段名稱或編號
'返回:當前記錄某字段值
'******************************************************************************
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
'******************************************************************************
'目的:設置/修改當前記錄某字段值
'輸入:字段名稱或編號,要設置的值
'返回:
'******************************************************************************
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 = "不允許保存只有一個字段的結果。"
Exit Property
End If
End If
Else
' AddValue = False
mlngErrNo = -1
mstrErrDescription = "請先使用AddField添加兩個或兩個以上字段。"
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 = "無效的字段。"
mlngErrNo = -1
Exit Property
E:
mlngErrNo = Err.Number
mstrErrDescription = Err.Description
End Property
'******************************************************************************
'目的:添加一個字段
'輸入:字段名稱
'返回:成功/失敗
'******************************************************************************
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
'******************************************************************************
'目的:移動到下一條記錄(記錄為空時不可移動)
'輸入:
'返回:成功/失敗
'******************************************************************************
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 = "目前記錄為空,無法移動!"
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
'******************************************************************************
'目的:移動記錄到第一條
'輸入:
'返回:成功/失敗
'******************************************************************************
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 = "目前記錄為空,無法移動!"
Exit Function
E:
MoveFirst = False
mlngErrNo = Err.Number
mstrErrDescription = Err.Description
End Function
'******************************************************************************
'目的:移動到某條記錄
'輸入:指定的記錄
'返回:成功/失敗
'******************************************************************************
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -