Access2Base - Buffer field objects in recordset

Field objects are buffered in a _Fields() array,
part of a Recordset instance,
to improve speed and memory consumption

Change-Id: Iac732ab5a1db24341aa30c3c934853a21c76e2e4

1 files changed, 60 insertions, 31 deletions

diff --git a/wizards/source/access2base/Recordset.xba b/wizards/source/access2base/Recordset.xba
index b16b15390097..0f7be5b01827 100644
--- a/wizards/source/access2base/Recordset.xba
+++ b/wizards/source/access2base/Recordset.xba
@@ -17,6 +17,7 @@ REM ----------------------------------------------------------------------------
 Private	_Type					As String				'	Must be RECORDSET
 Private _Name					As String				'	Unique, generated
 Private _This					As Object
+Private _Fields()				As Variant
 Private _ParentName				As String
 Private _ParentType				As String
 Private _ParentDatabase			As Object
@@ -51,6 +52,7 @@ Private Sub Class_Initialize()
 	_Type = OBJRECORDSET
 	_Name = ""
 	Set _This = Nothing
+	_Fields = Array()
 	_ParentName = ""
 	Set _ParentDatabase = Nothing
 	_ParentType = ""
@@ -371,6 +373,7 @@ Public Function mClose(ByVal Optional pbRemove As Boolean) As Variant
 '	If pbRemove = True, remove recordset from Recordsets collection
 
 Const cstThisSub = "Recordset.Close"
+Dim i As Integer
 
 	If _ErrorHandler() Then On Local Error Goto Exit_Function		'	Do not stop execution
 	Utils._SetCalledSub(cstThisSub)
@@ -393,6 +396,13 @@ Const cstThisSub = "Recordset.Close"
 	_BookmarkBeforeNew = Null
 	_BookmarkLastModified = Null
 	_IsClone = False
+	For i = 0 To UBound(_Fields)
+		If Not IsNull(_Fields(i)) Then
+			_Fields(i).Dispose()
+			Set _Fields(i) = Nothing
+		End If
+	Next i
+	_Fields = Array()
 	Set RowSet = Nothing
 	If IsMissing(pbRemove) Then pbRemove = True
 	If pbRemove Then _ParentDatabase.RecordsetsColl.Remove(_Name)
@@ -486,42 +496,61 @@ Const cstThisSub = "Recordset.Fields"
 	End If
 			
 Dim sObjects() As String, sObjectName As String, oObject As Object
-Dim i As Integer, bFound As Boolean, oFields As Object
+Dim i As Integer, oFields As Object, iIndex As Integer
+
+	'	No argument, return a collection
+	If IsMissing(pvIndex) Then
+		Set oObject = New Collect
+		oObject._CollType = COLLFIELDS
+		oObject._ParentType = OBJRECORDSET
+		oObject._ParentName = _Name
+		Set oObject._ParentDatabase = _ParentDatabase
+		oObject._Count = RowSet.getColumns().Count
+		Goto Exit_Function
+	End If
 
 	Set oFields = RowSet.getColumns()
 	sObjects = oFields.ElementNames()
-	Select Case True
-		Case IsMissing(pvIndex)
-			Set oObject = New Collect
-			oObject._CollType = COLLFIELDS
-			oObject._ParentType = OBJRECORDSET
-			oObject._ParentName = _Name
-			Set oObject._ParentDatabase = _ParentDatabase
-			oObject._Count = UBound(sObjects) + 1
-			Goto Exit_Function
-		Case VarType(pvIndex) = vbString
-			bFound = False
+
+	'	Argument is the field name
+	If VarType(pvIndex) = vbString Then
+		iIndex = -1
 		'	Check existence of object and find its exact (case-sensitive) name
-			For i = 0 To UBound(sObjects)
-				If UCase(pvIndex) = UCase(sObjects(i)) Then
-					sObjectName = sObjects(i)
-					bFound = True
-					Exit For
-				End If
-			Next i
-			If Not bFound Then Goto Trace_NotFound
-		Case Else		'	pvIndex is numeric
-			If pvIndex < 0 Or pvIndex > UBound(sObjects) Then Goto Trace_IndexError
-			sObjectName = sObjects(pvIndex)
-	End Select
+		For i = 0 To UBound(sObjects)
+			If UCase(pvIndex) = UCase(sObjects(i)) Then
+				sObjectName = sObjects(i)
+				iIndex = i
+				Exit For
+			End If
+		Next i
+		If iIndex < 0 Then Goto Trace_NotFound
+	'	Argument is numeric
+	Else
+		If pvIndex < 0 Or pvIndex > UBound(sObjects) Then Goto Trace_IndexError
+		sObjectName = sObjects(pvIndex)
+		iIndex = pvIndex
+	End If
 
-	Set oObject = New Field
-	oObject._Name = sObjectName
-	Set oObject.Column = oFields.getByName(sObjectName)
-	oObject._ParentName = _Name
-	oObject._ParentType = _Type
-	Set oObject._ParentDatabase = _ParentDatabase
-	Set oObject._ParentRecordset = _This
+	'	Check if field object already buffered in _Fields() array
+	If UBound(_Fields) < 0 Then		'	Initialize _Fields
+		ReDim _Fields(0 To UBound(sObjects))
+		For i = 0 To UBound(sObjects)
+			Set _Fields(i) = Nothing
+		Next i
+	End If
+	If Not IsNull(_Fields(iIndex)) Then
+		Set oObject = _Fields(iIndex)
+	'	Otherwise create new field object
+	Else
+		Set oObject = New Field
+		oObject._Name = sObjectName
+		Set oObject.Column = oFields.getByName(sObjectName)
+		oObject._ParentName = _Name
+		oObject._ParentType = _Type
+		Set oObject._ParentDatabase = _ParentDatabase
+		Set oObject._ParentRecordset = _This
+		Set _Fields(iIndex) = oObject
+	End If
 
 Exit_Function:
 	Set Fields = oObject