Access2Base - Review UtilProperty module

Insert dates and 2-dim arrays in property values
Export array or property values to string for file or database temporary storage
Reimport from string into array or property values
(for later use)

Change-Id: I7f2dc2ad6adde6249e68a6cb51b52e2a4dad79b7

4 files changed, 172 insertions, 36 deletions

diff --git a/wizards/source/access2base/Database.xba b/wizards/source/access2base/Database.xba
index 72445e0f3407..405eb65ae6c1 100644
--- a/wizards/source/access2base/Database.xba
+++ b/wizards/source/access2base/Database.xba
@@ -1322,6 +1322,8 @@ Const cstMaxRows = 200
 					If i = iNumFields - 1 Then vTdClass() = _AddArray(vTdClass, "lastcol")
 					If Not vFieldsBin(i) Then
 						If bDataArray Then vDataCell = pvData(i, j) Else vDataCell = vData(i, j)
+						If vDataCell Is Nothing Then vDataCell = Null		'	Necessary because Null object has not a VarType = vbNull
+						If IsDate(vDataCell) And VarType(vDataCell) = vbString Then vDataCell = CDate(vDataCell)
 						Select Case VarType(vDataCell)
 							Case vbEmpty, vbNull
 								vTdClass() = _AddArray(vTdClass, "null")
diff --git a/wizards/source/access2base/Recordset.xba b/wizards/source/access2base/Recordset.xba
index 0f7be5b01827..81061bdad875 100644
--- a/wizards/source/access2base/Recordset.xba
+++ b/wizards/source/access2base/Recordset.xba
@@ -581,11 +581,13 @@ Const cstThisSub = "Recordset.getProperty"
 End Function		'	getProperty
 
 REM -----------------------------------------------------------------------------------------------------------------------
-Public Function GetRows(ByVal Optional pvNumRows As variant) As Variant
+Public Function GetRows(ByVal Optional pvNumRows As variant, ByVal Optional pbStrDate As Boolean) As Variant
+'	UNPUBLISHED - pbStrDate = True forces all dates to be converted into strings
 
 	If _ErrorHandler() Then On Local Error Goto Error_Function
 Const cstThisSub = "Recordset.GetRows"
 	Utils._SetCalledSub(cstThisSub)
+	If IsMissing(pbStrDate) Then pbStrDate = False
 
 Dim vMatrix() As Variant, lSize As Long, iNumFields As Integer, i As Integer
 	vMatrix() = Array()
@@ -609,6 +611,7 @@ Dim vMatrix() As Variant, lSize As Long, iNumFields As Integer, i As Integer
 		lSize = lSize + 1
 		For i = 0 To iNumFields
 			vMatrix(i, lSize) = _getResultSetColumnValue(RowSet, i + 1)
+			If pbStrDate And IsDate(vMatrix(i, lSize)) Then vMatrix(i, lSize) = _CStr(vMatrix(i, lSize))
 		Next i
 		_Move("NEXT")
 	Loop
diff --git a/wizards/source/access2base/UtilProperty.xba b/wizards/source/access2base/UtilProperty.xba
index 6fbe1059e304..96e09552e948 100644
--- a/wizards/source/access2base/UtilProperty.xba
+++ b/wizards/source/access2base/UtilProperty.xba
@@ -22,24 +22,32 @@ REM ============================================================================
 '	Change Log
 '		Danny Brewer			Revised 2004-02-25-01
 '		Jean-Pierre Ledure		Adapted to Access2Base coding conventions
+'								PropValuesToStr rewritten and addition of StrToPropValues
+'								Bug corrected on date values
+'								Addition of support of 2-dimensional arrays
 '**********************************************************************
 
 Option Explicit
 
+Private Const cstHEADER = "### PROPERTYVALUES ###"
+
 REM =======================================================================================================================
 Public Function _MakePropertyValue(ByVal Optional psName As String, Optional pvValue As Variant) As com.sun.star.beans.PropertyValue
 '   Create and return a new com.sun.star.beans.PropertyValue.
 
-Dim oPropertyValue As Object
-	Set oPropertyValue = createUnoStruct( "com.sun.star.beans.PropertyValue" )
+Dim oPropertyValue As New com.sun.star.beans.PropertyValue
+
 	If Not IsMissing(psName) Then oPropertyValue.Name = psName
-	If Not IsMissing(pvValue) Then oPropertyValue.Value = pvValue
+	If Not IsMissing(pvValue) Then 
+		'	Date BASIC variables give error. Change them to strings
+		If VarType(pvValue) = vbDate Then oPropertyValue.Value = Utils._CStr(pvValue, False) Else oPropertyValue.Value = pvValue
+	End If
 	_MakePropertyValue() = oPropertyValue
 	
 End Function	'	_MakePropertyValue V1.3.0
 
 REM =======================================================================================================================
-Public Function _NumPropertyValues(pvPropertyValuesArray As Variant) As Integer
+Public Function _NumPropertyValues(ByRef pvPropertyValuesArray As Variant) As Integer
 ' Return the number of PropertyValue's in an array.
 ' Parameters:
 ' 	pvPropertyValuesArray - an array of PropertyValue's, that is an array of com.sun.star.beans.PropertyValue.
@@ -52,7 +60,7 @@ Dim iNumProperties As Integer
 End Function	'	_NumPropertyValues V1.3.0
 
 REM =======================================================================================================================
-Public Function _FindPropertyIndex(pvPropertyValuesArray, ByVal psPropName As String ) As Integer
+Public Function _FindPropertyIndex(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String ) As Integer
 ' Find a particular named property from an array of PropertyValue's.
 ' Finds the index in the array of PropertyValue's and returns it, or returns -1 if it was not found.
 
@@ -70,7 +78,7 @@ Dim iNumProperties As Integer, i As Integer, vProp As Variant
 End Function	'	_FindPropertyIndex V1.3.0
 
 REM =======================================================================================================================
-Public Function _FindProperty(pvPropertyValuesArray, ByVal psPropName As String) As com.sun.star.beans.PropertyValue
+Public Function _FindProperty(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String) As com.sun.star.beans.PropertyValue
 ' Find a particular named property from an array of PropertyValue's.
 ' Finds the PropertyValue and returns it, or returns Null if not found.
 
@@ -84,43 +92,59 @@ Dim iPropIndex As Integer, vProp As Variant
 End Function	'	_FindProperty V1.3.0
 
 REM =======================================================================================================================
-Function _GetPropertyValue(pvPropertyValuesArray, ByVal psPropName As String, Optional pvDefaultValue) As Variant
+Public Function _GetPropertyValue(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String, Optional pvDefaultValue) As Variant
 ' Get the value of a particular named property from an array of PropertyValue's.
 ' vDefaultValue      -   This value is returned if the property is not found in the array.
 
-Dim iPropIndex As Integer, vProp As Variant, vValue As Variant
+Dim iPropIndex As Integer, vProp As Variant, vValue As Variant, vMatrix As Variant, i As Integer, j As Integer
 	iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
 	If iPropIndex >= 0 Then
 		vProp = pvPropertyValuesArray(iPropIndex)	' access array subscript
 		vValue = vProp.Value						' get the value from the PropertyValue
-		_GetPropertyValue() = vValue
+		If IsArray(vValue) Then
+			If IsArray(vValue(0)) Then				' Array of arrays
+				vMatrix = Array()
+				ReDim vMatrix(0 To UBound(vValue), 0 To UBound(vValue(0)))
+				For i = 0 To UBound(vValue)
+					For j = 0 To UBound(vValue(0))
+						vMatrix(i, j) = vValue(i)(j)
+					Next j
+				Next i
+				_GetPropertyValue() = vMatrix
+			Else
+				_GetPropertyValue() = vValue		' Simple vector OK
+			End If
+		Else
+			_GetPropertyValue() = vValue
+		End If
 	Else
 		If IsMissing(pvDefaultValue) Then pvDefaultValue = Null
 		_GetPropertyValue() = pvDefaultValue
    EndIf
+
 End Function	'	_GetPropertyValue V1.3.0
 
 REM =======================================================================================================================
-Sub _SetPropertyValue(pvPropertyValuesArray, ByVal psPropName As String, ByVal pvValue)
+Public Sub _SetPropertyValue(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String, ByVal pvValue)
 ' Set the value of a particular named property from an array of PropertyValue's.
 
 Dim iPropIndex As Integer, vProp As Variant, iNumProperties As Integer
+
 	iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
-	' Did we find it?
 	If iPropIndex >= 0 Then
-	' Found, the PropertyValue is already in the array. Just modify its value.
+	'	Found, the PropertyValue is already in the array. Just modify its value.
 		vProp = pvPropertyValuesArray(iPropIndex)	' access array subscript
 		vProp.Value = pvValue						' set the property value.
 		pvPropertyValuesArray(iPropIndex) = vProp	' put it back into array
 	Else
-	' Not found, the array contains no PropertyValue with this name. Append new element to array.
+	'	Not found, the array contains no PropertyValue with this name. Append new element to array.
 		iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
 		If iNumProperties = 0 Then
 			pvPropertyValuesArray = Array(_MakePropertyValue(psPropName, pvValue))
 		Else
-		' Make array larger.
+		'	Make array larger.
 			Redim Preserve pvPropertyValuesArray(iNumProperties)
-			' Assign new PropertyValue
+			'	Assign new PropertyValue
 			pvPropertyValuesArray(iNumProperties) = _MakePropertyValue(psPropName, pvValue)
 		EndIf
 	EndIf
@@ -128,17 +152,17 @@ Dim iPropIndex As Integer, vProp As Variant, iNumProperties As Integer
 End Sub		'	_SetPropertyValue V1.3.0
 
 REM =======================================================================================================================
-Sub _DeleteProperty(pvPropertyValuesArray, ByVal psPropName As String)
+Public Sub _DeleteProperty(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String)
 ' Delete a particular named property from an array of PropertyValue's.
 
 Dim iPropIndex As Integer
 	iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
-	_DeleteIndexedProperty(pvPropertyValuesArray, iPropIndex)
+	If iPropIndex >= 0 Then _DeleteIndexedProperty(pvPropertyValuesArray, iPropIndex)
 
 End Sub		'	_DeletePropertyValue V1.3.0
 
 REM =======================================================================================================================
-Public Sub _DeleteIndexedProperty(pvPropertyValuesArray, ByVal piPropIndex As Integer)
+Public Sub _DeleteIndexedProperty(ByRef pvPropertyValuesArray As Variant, ByVal piPropIndex As Integer)
 ' Delete a particular indexed property from an array of PropertyValue's.
 
 Dim iNumProperties As Integer, i As Integer
@@ -146,40 +170,139 @@ Dim iNumProperties As Integer, i As Integer
 
 	' Did we find it?
 	If piPropIndex < 0 Then
-		' Do nothing
+		'	Do nothing
 	ElseIf iNumProperties = 1 Then
-		' Just return a new empty array
+		'	Just return a new empty array
 		pvPropertyValuesArray = Array()
 	Else
-		' If it is NOT the last item in the array, then shift other elements down into it's position.
+		'	If it is NOT the last item in the array, then shift other elements down into it's position.
 		If piPropIndex < iNumProperties - 1 Then
-			' Bump items down lower in the array.
+			'	Bump items down lower in the array.
 			For i = piPropIndex To iNumProperties - 2
 				pvPropertyValuesArray(i) = pvPropertyValuesArray(i + 1)
 			Next i
 		EndIf
-		' Redimension the array to have one fewer element.
+		'	Redimension the array to have one fewer element.
 		Redim Preserve pvPropertyValuesArray(iNumProperties - 2)
 	EndIf
 
 End Sub		'	_DeleteIndexedProperty V1.3.0
 
 REM =======================================================================================================================
-Public Function _PropValuesToStr(pvPropertyValuesArray) As String
-' Convenience function to return a string which explains what PropertyValue's are in the array of PropertyValue's.
+Public Function _PropValuesToStr(ByRef pvPropertyValuesArray As Variant) As String
+' Return a string with dumped content of the array of PropertyValue's.
+'	SYNTAX:
+'		NameOfProperty = This is a string (or 12 or 2016-12-31 12:05 or 123.45 or -0.12E-05 ...)
+'		NameOfArray = (10)
+'		1;2;3;4;5;6;7;8;9;10
+'		NameOfMatrix = (2,10)
+'		1;2;3;4;5;6;7;8;9;10
+'		A;B;C;D;E;F;G;H;I;J
+'	Semicolons and backslashes are escaped with a backslash (see _CStr and _CVar functions)
+
+Dim iNumProperties As Integer, sResult As String, i As Integer, j As Integer, vProp As Variant
+Dim sName As String, vValue As Variant, iType As Integer, vVector As Variant
+Dim cstLF As String
 
-Dim iNumProperties As Integer, sResult As String, i As Integer, vProp As Variant
-Dim sName As String, vValue As Variant
+	cstLF = Chr(10)
 	iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
 
-	sResult = Cstr(iNumProperties) & " Properties:"
+	sResult = cstHEADER & cstLF
 	For i = 0 To iNumProperties - 1
 		vProp = pvPropertyValuesArray(i)
 		sName = vProp.Name
 		vValue = vProp.Value
-		sResult = sResult & Chr(13) & "  " & sName & " = " & _CStr(vValue)
+		iType = VarType(vValue)
+		Select Case iType
+			Case < vbArray					'	Scalar
+				sResult = sResult & sName & " = " & Utils._CStr(vValue, False) & cstLF
+			Case Else						'	Vector or matrix
+				'	1-dimension but vector of vectors must also be considered
+				If VarType(vValue(0)) >= vbArray Then
+					sResult = sResult & sName & " = (" & UBound(vValue) + 1 & "," & UBound(vValue(0)) + 1 & ")" & cstLF
+					vVector = Array()
+					ReDim vVector(0 To UBound(vValue(0)))
+					For j = 0 To UBound(vValue)
+						sResult = sResult & Utils._CStr(vValue(j), False) & cstLF
+					Next j			
+				Else
+					sResult = sResult & sName & " = (" & UBound(vValue, 1) + 1 & ")" & cstLF
+					sResult = sResult & Utils._CStr(vValue, False) & cstLF
+				End If
+		End Select
 	Next i
-	_PropValuesToStr() = sResult
+
+	_PropValuesToStr() = Left(sResult, Len(sResult) - 1)	'	Remove last LF
 
 End Function	'	_PropValuesToStr V1.3.0
+
+REM =======================================================================================================================
+Public Function _StrToPropValues(psString) As Variant
+' Return an array of PropertyValue's rebuilt from the string parameter
+
+Dim vString() As Variant, i As Integer,iArray As Integer, iRows As Integer, iCols As Integer
+Dim lPosition As Long, sName As String, vValue As Variant, vResult As Variant, sDim As String
+Dim lSearch As Long
+Dim cstLF As String
+Const cstEqualArray = " = (", cstEqual = " = "
+
+	cstLF = Chr(10)
+	_StrToPropValues = Array()
+	vResult = Array()
+	
+	If psString = "" Then Exit Function
+	vString = Split(psString, cstLF)
+	If UBound(vString) <= 0 Then Exit Function		'	There must be at least one name-value pair
+	If vString(0) <> cstHEADER Then Exit Function	'	Check origin
+
+	iArray = -1
+	For i = 1 To UBound(vString)
+		If vString(i) <> "" Then			'	Skip empty lines
+			If iArray < 0 Then				'	Not busy with array row
+				lPosition = 1
+				sName = Utils._RegexSearch(vString(i), "^\b\w+\b", lPosition)		'	Identifier
+				If sName = "" Then Exit Function
+				If InStr(vString(i), cstEqualArray) = lPosition + Len(sName) Then	'	Start array processing
+					lSearch = lPosition + Len(sName) + Len(cstEqualArray) - 1
+					sDim = Utils._RegexSearch(vString(i), "\([0-9]+\)", lSearch)	'	e.g. (10)
+					If sDim <> "" Then
+						iCols = CInt(Mid(sDim, 2, Len(sDim) - 2)
+						iRows = 0
+						ReDim vValue(0 To iCols - 1)
+					Else
+						lSearch = lPosition + Len(sName) + Len(cstEqualArray) - 1
+						sDim = Utils._RegexSearch(vString(i), "\([0-9]+,", lSearch)	'	e.g. (10,
+						iRows = CInt(Mid(sDim, 2, Len(sDim) - 2)
+						sDim = Utils._RegexSearch(vString(i), ",[0-9]+\)", lSearch)	'	e.g. ,20)
+						iCols = CInt(Mid(sDim, 2, Len(sDim) - 2)
+						ReDim vValue(0 To iRows - 1)
+					End If
+					iArray = 0
+				ElseIf InStr(vString(i), cstEqual) = lPosition + Len(sName) Then
+					vValue = Utils._CVar(Mid(vString(i), Len(sName) + Len(cstEqual) + 1))
+					_SetPropertyValue(vResult, sName, vValue)
+				Else
+					Exit Function
+				End If
+			Else							'	Line is an array row
+				If iRows = 0 Then
+					vValue = Utils._CVar(vString(i), True)		'	Keep dates as strings
+					iArray = -1
+					_SetPropertyValue(vResult, sName, vValue)
+				Else
+					vValue(iArray) = Utils._CVar(vString(i), True)
+					If iArray < iRows - 1 Then
+						iArray = iArray + 1
+					Else
+						iArray = -1
+						_SetPropertyValue(vResult, sName, vValue)
+					End If
+				End If
+			End If
+		End If
+	Next i
+	
+	_StrToPropValues = vResult
+
+End Function
 </script:module>
\ No newline at end of file
diff --git a/wizards/source/access2base/Utils.xba b/wizards/source/access2base/Utils.xba
index 583348b096a8..6028df496253 100644
--- a/wizards/source/access2base/Utils.xba
+++ b/wizards/source/access2base/Utils.xba
@@ -146,7 +146,7 @@ Const cstByteLength = 25
 				sArg = &quot;[ARRAY]&quot;
 			Else	&apos;	One-dimension arrays only
 				For i = LBound(pvArg) To UBound(pvArg)
-					sArg = sArg &amp; Utils._CStr(pvArg(i)) &amp; &quot;;&quot;	&apos;	Recursive call
+					sArg = sArg &amp; Utils._CStr(pvArg(i), pbShort) &amp; &quot;;&quot;	&apos;	Recursive call
 				Next i
 				If Len(sArg) &gt; 1 Then sArg = Left(sArg, Len(sArg) - 1)
 			End If
@@ -205,10 +205,11 @@ Const cstByteLength = 25
 End Function	&apos;	CStr			V0.9.5
 
 REM -----------------------------------------------------------------------------------------------------------------------
-Public Function _CVar(ByRef psArg As String) As Variant
+Public Function _CVar(ByRef psArg As String, ByVal Optional pbStrDate As Boolean) As Variant
 &apos;	psArg is presumed an output of _CStr (stored in the mean time in a text file f.i.)
 &apos;	_CVar returns the corresponding original variant variable or Null/Nothing if not possible
 &apos;	Return values may of types Array, Long, Double, Date, Boolean, String, Null or Empty
+&apos;	pbStrDate = True keeps dates as strings
 
 Dim cstEscape1 As String, cstEscape2 As String, vEMPTY As Variant
 	cstEscape1 = Chr(14)			&apos;	Form feed used as temporary escape character for \\
@@ -218,6 +219,7 @@ Dim cstEscape1 As String, cstEscape2 As String, vEMPTY As Variant
 	If Len(psArg) = 0 Then Exit Function
 
 Dim sArg As String, vArgs() As Variant, vVars() As Variant, i As Integer
+	If IsMissing(pbStrDate) Then pbStrDate = False
 	sArg = Replace( _
 				Replace( _
 					Replace( _
@@ -232,7 +234,7 @@ Dim sArg As String, vArgs() As Variant, vVars() As Variant, i As Integer
 		vVars = Array()
 		Redim vVars(LBound(vArgs) To UBound(vArgs))
 		For i = LBound(vVars) To UBound(vVars)
-			vVars(i) = _CVar(vArgs(i))
+			vVars(i) = _CVar(vArgs(i), pbStrDate)
 		Next i
 		_CVar = vVars
 		Exit Function
@@ -245,14 +247,15 @@ Dim sArg As String, vArgs() As Variant, vVars() As Variant, i As Integer
 		Case sArg = &quot;[OBJECT]&quot;						:	_CVar = Nothing
 		Case sArg = &quot;[TRUE]&quot;						:	_CVar = True
 		Case sArg = &quot;[FALSE]&quot;						:	_CVar = False
-		Case IsDate(sArg)							:	_CVar = CDate(sArg)
+		Case IsDate(sArg)
+			If pbStrDate Then _CVar = sArg Else _CVar = CDate(sArg)
 		Case IsNumeric(sArg)
 			If InStr(sArg, &quot;.&quot;) &gt; 0 Then
 				_CVar = Val(sArg)
 			Else
 				_CVar = CLng(Val(sArg))		&apos;	Val always returns a double
 			End If
-		Case _RegexSearch(sArg, &quot;^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$&quot; &lt;&gt; &quot;&quot;
+		Case _RegexSearch(sArg, &quot;^[-+]?[0-9]*\.?[0-9]+(e[-+]?[0-9]+)?$&quot;) &lt;&gt; &quot;&quot;
 			_CVar = Val(sArg)					&apos;	Scientific notation
 		Case Else									:	_CVar = Replace(Replace(sArg, cstEscape1, &quot;\&quot;), cstEscape2, &quot;;&quot;)
 	End Select
@@ -914,6 +917,7 @@ Function _RegexSearch(ByRef psString As String _
 						, ByVal psRegex As String _
 						, Optional ByRef plStart As Long _
 						) As String
+&apos;	Search is not case-sensitive
 &apos;	Return &quot;&quot; if regex not found, otherwise returns the matching string
 &apos;	plStart = start position of psString to search (starts at 1)
 &apos;	In output plStart contains the first position of the matching string
@@ -929,9 +933,11 @@ Dim lEnd As Long
 		.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
 		.searchFlag = 0
 		.searchString = psRegex				&apos;	Pattern to be searched
+		.transliterateFlags = com.sun.star.i18n.TransliterationModules.IGNORE_CASE
 	End With
 	oTextSearch.setOptions(vOptions)
 	If IsMissing(plStart) Then plStart = 1
+	If plStart &lt;= 0 Then Exit Function
 	lEnd = Len(psString)
 	vResult = oTextSearch.searchForward(psString, plStart - 1, lEnd)
 	With vResult
@@ -939,6 +945,8 @@ Dim lEnd As Long
 			plStart = .startOffset(0) + 1
 			lEnd = .endOffset(0) + 1
 			_RegexSearch = Mid(psString, plStart, lEnd - plStart)
+		Else
+			plStart = 0
 		End If
 	End With