Access2Base - Implement regex search

Based on XTextSearch UNO service
_CStr also refined

Change-Id: Ibeceeeb549511e575c6842e43e5a76c8308db1aa

wizards/source/access2base/Root_.xba

@@ -29,6 +29,7 @@ Private DebugPrintShort		As Boolean
 Private Introspection		As Object				'	com.sun.star.beans.Introspection	
 Private VersionNumber		As String				'	Actual Access2Base version number
 Private Locale				As String
+Private TextSearch			As Object
 Private FindRecord			As Object
 Private StatusBar			As Object
 Private Dialogs				As Object				'	Collection
@@ -51,6 +52,7 @@ Dim vCurrentDoc() As Variant
 	DebugPrintShort = True
 	Locale = L10N._GetLocale()
 	Set Introspection = CreateUnoService("com.sun.star.beans.Introspection")
+	Set TextSearch = CreateUnoService("com.sun.star.util.TextSearch")
 	Set FindRecord = Nothing
 	Set StatusBar = Nothing
 	Set Dialogs = New Collection

wizards/source/access2base/Utils.xba

@@ -127,7 +127,7 @@ End Function	'	CheckArgument	V0.9.0
 REM -----------------------------------------------------------------------------------------------------------------------
 Public Function _CStr(ByVal pvArg As Variant, ByVal Optional pbShort As Boolean) As String
 '	Convert pvArg into a readable string (truncated if too long and pbShort = True or missing)
-'	pvArg may be a byte-array. Other arrays are rejected
+'	pvArg may be a byte-array. Other arrays are processed recursively into a semicolon separated string
 
 Dim sArg As String, sObject As String, oArg As Object, sLength As String, i As Long, iMax As Long
 Const cstLength = 50
@@ -174,9 +174,17 @@ Const cstByteLength = 25
 				End If
 			Case vbVariant			:		sArg = "[VARIANT]"
 			Case vbString
-				'	Replace CR + LF by \n
+				'	Replace CR + LF by \n and HT by \t
 				'	Replace semicolon by \; to allow semicolon separated rows
-				sArg = Replace(Replace(Replace(pvArg, Chr(13), ""), Chr(10), "\n"), ";", "\;")
+				sArg = Replace( _
+							Replace( _
+								Replace( _
+									Replace( _
+										Replace(pvArg, "\", "\\") _
+									, Chr(13), "") _
+								, Chr(10), "\n") _
+							, Chr(9), "\t") _
+						, ";", "\;")
 			Case vbBoolean			:		sArg = Iif(pvArg, "[TRUE]", "[FALSE]")
 			Case vbByte				:		sArg = Right("00" & Hex(pvArg), 2)
 			Case vbSingle, vbDouble, vbCurrency
@@ -196,6 +204,61 @@ Const cstByteLength = 25
 	
 End Function	'	CStr			V0.9.5
 
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function _CVar(ByRef psArg As String) As Variant
+'	psArg is presumed an output of _CStr (stored in the mean time in a text file f.i.)
+'	_CVar returns the corresponding original variant variable or Null/Nothing if not possible
+'	Return values may of types Array, Long, Double, Date, Boolean, String, Null or Empty
+
+Dim cstEscape1 As String, cstEscape2 As String, vEMPTY As Variant
+	cstEscape1 = Chr(14)			'	Form feed used as temporary escape character for \\
+	cstEscape2 = Chr(27)			'	ESC used as temporary escape character for \;
+
+	_CVar = ""
+	If Len(psArg) = 0 Then Exit Function
+
+Dim sArg As String, vArgs() As Variant, vVars() As Variant, i As Integer
+	sArg = Replace( _
+				Replace( _
+					Replace( _
+						Replace(psArg, "\\", cstEscape1) _
+					, "\;", cstEscape2) _
+				, "\n", Chr(10)) _
+			, "\t", Chr(9))
+
+	'	Semicolon separated string
+	vArgs = Split(sArg, ";")
+	If UBound(vArgs) > LBound(vArgs) Then		'	Process each item recursively
+		vVars = Array()
+		Redim vVars(LBound(vArgs) To UBound(vArgs))
+		For i = LBound(vVars) To UBound(vVars)
+			vVars(i) = _CVar(vArgs(i))
+		Next i
+		_CVar = vVars
+		Exit Function
+	End If
+
+	'	Usual case
+	Select Case True
+		Case sArg = "[EMPTY]"						:	_CVar = vEMPTY
+		Case sArg = "[NULL]" Or sArg = "[VARIANT]"	:	_CVar = Null
+		Case sArg = "[OBJECT]"						:	_CVar = Nothing
+		Case sArg = "[TRUE]"						:	_CVar = True
+		Case sArg = "[FALSE]"						:	_CVar = False
+		Case IsDate(sArg)							:	_CVar = CDate(sArg)
+		Case IsNumeric(sArg)
+			If InStr(sArg, ".") > 0 Then
+				_CVar = Val(sArg)
+			Else
+				_CVar = CLng(Val(sArg))		'	Val always returns a double
+			End If
+		Case _RegexSearch(sArg, "^[-+]?[0-9]*\.?[0-9]+([eE][-+]?[0-9]+)?$" <> ""
+			_CVar = Val(sArg)					'	Scientific notation
+		Case Else									:	_CVar = Replace(Replace(sArg, cstEscape1, "\"), cstEscape2, ";")
+	End Select
+
+End Function	'	CVar			V1.7.0
+
 REM -----------------------------------------------------------------------------------------------------------------------
 Public Function _DecimalPoint() As String
 'Return locale decimal point
@@ -846,6 +909,41 @@ Error_Function:
 	Resume Exit_Function
 End Function	'	_ReadFileIntoArray	V1.4.0
 
+REM -----------------------------------------------------------------------------------------------------------------------
+Function _RegexSearch(ByRef psString As String _
+						, ByVal psRegex As String _
+						, Optional ByRef plStart As Long _
+						) As String
+'	Return "" if regex not found, otherwise returns the matching string
+'	plStart = start position of psString to search (starts at 1)
+'	In output plStart contains the first position of the matching string
+'	To search again the same or another pattern => plStart = plStart + Len(matching string)
+
+Dim oTextSearch As Object
+Dim vOptions As New com.sun.star.util.SearchOptions, vResult As Object
+Dim lEnd As Long
+
+	_RegexSearch = ""
+	Set oTextSearch = _A2B_.TextSearch		'	UNO XTextSearch service
+	With vOptions
+		.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
+		.searchFlag = 0
+		.searchString = psRegex				'	Pattern to be searched
+	End With
+	oTextSearch.setOptions(vOptions)
+	If IsMissing(plStart) Then plStart = 1
+	lEnd = Len(psString)
+	vResult = oTextSearch.searchForward(psString, plStart - 1, lEnd)
+	With vResult
+		If .subRegExpressions >= 1 Then
+			plStart = .startOffset(0) + 1
+			lEnd = .endOffset(0) + 1
+			_RegexSearch = Mid(psString, plStart, lEnd - plStart)
+		End If
+	End With
+
+End Function
+
 REM -----------------------------------------------------------------------------------------------------------------------
 Function _RegisterEventScript(poObject As Object _
 								, ByVal psEvent As String _