Access2Base - Addition of Module object

New Module Basic module
New AllModules() collection in Application module
Extension of regex to backward searches

Change-Id: Id58f3b29d08e9f0b73e192cfc0c2a99988e73fcf

wizards/Package_access2base.mk

@@ -40,6 +40,7 @@ $(eval $(call gb_Package_add_files,wizards_basicsrvaccess2base,$(LIBO_SHARE_FOLD
 	Form.xba \
 	L10N.xba \
 	Methods.xba \
+	Module.xba \
 	OptionGroup.xba \
 	PropertiesGet.xba \
 	PropertiesSet.xba \

wizards/source/access2base/Application.xba

@@ -45,6 +45,7 @@ Global Const ERRSQLSTATEMENT		=	1523
 Global Const ERROBJECTNOTFOUND		=	1524
 Global Const ERROPENOBJECT			=	1525
 Global Const ERRCLOSEOBJECT			=	1526
+Global Const ERRMETHOD				=	1527
 Global Const ERRACTION				=	1528
 Global Const ERRSENDMAIL			=	1529
 Global Const ERRFORMYETOPEN			=	1530
@@ -74,6 +75,8 @@ Global Const ERRSUBFORMNOTFOUND		=	1553
 Global Const ERRWINDOW				=	1554
 Global Const ERRCOMPATIBILITY		=	1555
 Global Const ERRPRECISION			=	1556
+Global Const ERRMODULENOTFOUND		=	1557
+Global Const ERRPROCEDURENOTFOUND	=	1558
 
 REM -----------------------------------------------------------------------------------------------------------------------
 Global Const DBCONNECTBASE			=	1			'	Connection from Base document (OpenConnection)
@@ -94,6 +97,7 @@ Global Const DBMS_SQLITE			=	8
 REM -----------------------------------------------------------------------------------------------------------------------
 Global Const COLLALLDIALOGS 		= "ALLDIALOGS"
 Global Const COLLALLFORMS			= "ALLFORMS"
+Global Const COLLALLMODULES			= "ALLMODULES"
 Global Const COLLCOMMANDBARS		= "COMMANDBARS"
 Global Const COLLCOMMANDBARCONTROLS	= "COMMANDBARCONTROLS"
 Global Const COLLCONTROLS			= "CONTROLS"
@@ -116,6 +120,7 @@ Global Const OBJDIALOG				= "DIALOG"
 Global Const OBJEVENT				= "EVENT"
 Global Const OBJFIELD				= "FIELD"
 Global Const OBJFORM				= "FORM"
+Global Const OBJMODULE				= "MODULE"
 Global Const OBJOPTIONGROUP			= "OPTIONGROUP"
 Global Const OBJPROPERTY			= "PROPERTY"
 Global Const OBJQUERYDEF			= "QUERYDEF"
@@ -159,6 +164,10 @@ Global Const CTLPARENTISSUBFORM	= "SUBFORM"
 Global Const CTLPARENTISGRID	= "GRID"
 Global Const CTLPARENTISGROUP	= "OPTIONGROUP"
 
+REM -----------------------------------------------------------------------------------------------------------------------
+Global Const MODDOCUMENT		= "DOCUMENT"
+Global Const MODGLOBAL			= "GLOBAL"
+
 REM -----------------------------------------------------------------------------------------------------------------------
 Type DocContainer
 	Document			As Object				'	com.sun.star.comp.dba.ODatabaseDocument	or SwXTextDocument or ScModelObj
@@ -205,9 +214,11 @@ Const cstSepar = "!"
 	Set oMacLibraries = DialogLibraries
 	vMacLibraries = oMacLibraries.getElementNames()
 	'Remove Access2Base from the list
-	For i = 0 To UBound(vMacLibraries)
-		If Left(vMacLibraries(i), 11) = "Access2Base" Then vMacLibraries(i) = ""
-	Next i
+	If _A2B_.ExcludeA2B Then
+		For i = 0 To UBound(vMacLibraries)
+			If Left(vMacLibraries(i), 11) = "Access2Base" Then vMacLibraries(i) = ""
+		Next i
+	End If
 	vMacLibraries = Utils._TrimArray(vMacLibraries)
 
 	If UBound(vDocLibraries) + UBound(vMacLibraries) < 0 Then				'	No library
@@ -393,6 +404,149 @@ Error_Function:
 	GoTo Exit_Function
 End Function		'	AllForms	V0.9.0
 
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function AllModules(ByVal Optional pvIndex As Variant, ByVal Optional pbAllModules As Boolean) As Variant
+'	Return either a Collection or a Module object
+'	The modules are selected only if library is loaded
+'	(UNPUBLISHED) pbAllModules = False collects only the modules located in the currently open document
+
+	If _ErrorHandler() Then On Local Error Goto Error_Function
+Const cstThisSub = "AllModules"
+	Utils._SetCalledSub(cstThisSub)
+
+Dim iMode As Integer, vModules() As Variant, i As Integer, j As Integer, iCount As Integer
+Dim oMacLibraries As Object, vAllModules As Variant, oLibrary As Object, vNames() As Variant, bFound As Boolean
+Dim sScript As String, sLibrary As String, oDocLibraries As Object, sStorage As String
+Dim vLibraries() As Variant, vMacLibraries() As Variant, vDocLibraries() As Variant, oDocMacLib As Object
+Const cstCount = 0, cstByIndex = 1, cstByName = 2
+Const cstDot = "."
+
+	If IsMissing(pvIndex) Then
+		iMode = cstCount
+	Else
+		If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
+		If VarType(pvIndex) = vbString Then
+			iMode = cstByName
+			'	Dtermine full name STORAGE.LIBRARY.MODULE
+			vNames = Split(pvIndex, cstDot)
+			If UBound(vNames) = 2 Then
+			ElseIf UBound(vNames) = 1 Then
+				pvIndex = MODDOCUMENT & cstDot & pvIndex
+			ElseIf UBound(vNames) = 0 Then
+				pvIndex = MODDOCUMENT & cstDot & "STANDARD" & cstDot & pvIndex
+			Else
+				GoTo Trace_Not_Found
+			End If
+		Else
+			iMode = cstByIndex
+		End If
+	End If
+
+	If IsMissing(pbAllModules) Then pbAllModules = True
+	If Not Utils._CheckArgument(pbAllModules, 2, vbBoolean) Then Goto Exit_Function
+
+	Set vAllModules = Nothing
+
+	Set oDocLibraries = ThisComponent.BasicLibraries
+	vDocLibraries = oDocLibraries.getElementNames()
+	If pbAllModules Then
+		Set oMacLibraries = GlobalScope.BasicLibraries
+		vMacLibraries = oMacLibraries.getElementNames()
+		'Remove Access2Base from the list
+		If _A2B_.ExcludeA2B Then
+			For i = 0 To UBound(vMacLibraries)
+				If Left(vMacLibraries(i), 11) = "Access2Base" Then vMacLibraries(i) = ""
+			Next i
+		End If
+		vMacLibraries = Utils._TrimArray(vMacLibraries)
+	End If
+
+	If UBound(vDocLibraries) + UBound(vMacLibraries) < 0 Then				'	No library
+		Set vAllModules = New Collect
+		vAllModules._CollType = COLLALLMODULES
+		vAllModules._ParentType = OBJAPPLICATION
+		vAllModules._ParentName = ""
+		vAllModules._Count = 0
+		Goto Exit_Function
+	End If
+	
+	iCount = 0
+	For i = 0 To UBound(vDocLibraries) + UBound(vMacLibraries) + 1
+		bFound = False
+		If i <= UBound(vDocLibraries) Then
+			sLibrary = vDocLibraries(i)
+			sStorage = MODDOCUMENT
+			Set oDocMacLib = oDocLibraries
+			'	Sometimes library not loaded as should ??
+			If Not oDocMacLib.IsLibraryLoaded(sLibrary) Then oDocMacLib.loadLibrary(sLibrary)
+		Else
+			sLibrary = vMacLibraries(i - UBound(vDocLibraries) - 1)
+			sStorage = MODGLOBAL
+			Set oDocMacLib = oMacLibraries
+		End If
+		If oDocMacLib.IsLibraryLoaded(sLibrary) Then
+			Set oLibrary = oDocMacLib.getByName(sLibrary)
+			If oLibrary.hasElements() Then
+				vModules = oLibrary.getElementNames()
+				Select Case iMode
+					Case cstCount
+						iCount = iCount + UBound(vModules) + 1
+					Case cstByIndex, cstByName
+						For j = 0 To UBound(vModules)
+							If iMode = cstByIndex Then
+								If pvIndex = iCount Then bFound = True
+								iCount = iCount + 1
+							Else
+								If UCase(pvIndex) = UCase(sStorage & cstDot & sLibrary & cstDot & vModules(j)) Then bFound = True
+							End If
+							If bFound Then
+								sScript = oLibrary.getByName(vModules(j))	'	Initiate Module object
+								iCount = i
+								Exit For
+							End If
+						Next j
+				End Select						
+			End If
+		End If
+		If bFound Then Exit For
+	Next i
+	
+	If iMode = cstCount Then
+		Set vAllModules = New Collect
+		vAllModules._CollType = COLLALLMODULES
+		vAllModules._ParentType = OBJAPPLICATION
+		vAllModules._ParentName = ""
+		vAllModules._Count = iCount
+	Else
+		If Not bFound Then
+			If iMode = cstByIndex Then Goto Trace_Error_Index Else Goto Trace_Not_Found
+		End If
+		Set vAllModules = New Module
+		vAllModules._Name = vModules(j)
+		vAllModules._LibraryName = sLibrary
+		Set vAllModules._Library = oLibrary
+		vAllModules._Storage = sStorage
+		vAllModules._Script = sScript
+		vAllModules._Initialize()
+	End If
+
+Exit_Function:
+	Set AllModules = vAllModules
+	Utils._ResetCalledSub(cstThisSub)
+	Exit Function
+Trace_Not_Found:
+	TraceError(TRACEFATAL, ERRMODULENOTFOUND, Utils._CalledSub(), 0, , pvIndex)
+	Goto Exit_Function
+Trace_Error_Index:
+	TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0, 1)
+	Set vModules = Nothing
+	Goto Exit_Function
+Error_Function:
+	TraceError(TRACEABORT, Err, cstThisSub, Erl)
+	Set vModules = Nothing
+	GoTo Exit_Function
+End Function		'	AllModules	V1.7.0
+
 REM -----------------------------------------------------------------------------------------------------------------------
 Public Sub CloseConnection ()
 				

wizards/source/access2base/Collect.xba

@@ -10,7 +10,7 @@ Option ClassModule
 
 Option Explicit
 
-REM MODULE NAME <> COLLECTION (seems a reserved name ?)
+REM MODULE NAME <> COLLECTION (is a reserved name for ... collections)
 
 REM -----------------------------------------------------------------------------------------------------------------------
 REM --- CLASS ROOT FIELDS 								        														---
@@ -77,6 +77,8 @@ Dim vNames() As Variant, oProperty As Object
 			Set Item = Application.AllDialogs(pvItem)
 		Case COLLALLFORMS
 			Set Item = Application.AllForms(pvItem)
+		Case COLLALLMODULES
+			Set Item = Application.AllModules(pvItem)
 		Case COLLCOMMANDBARS
 			Set Item = Application.CommandBars(pvItem)
 		Case COLLCOMMANDBARCONTROLS

wizards/source/access2base/Dialog.xba

@@ -14,7 +14,7 @@ REM ----------------------------------------------------------------------------
 REM --- CLASS ROOT FIELDS 								        														---
 REM -----------------------------------------------------------------------------------------------------------------------
 
-Private	_Type					As String				'	Must be FORM
+Private	_Type					As String				'	Must be DIALOG
 Private	_Name					As String
 Private _Shortcut				As String
 Private _Dialog					As Object				'	com.sun.star.io.XInputStreamProvider
@@ -199,7 +199,11 @@ Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
 '		a Collection object if pvIndex absent
 '		a Property object otherwise
 
+Const cstThisSub = "Dialog.Properties"
+	Utils._SetCalledSub(cstThisSub)
+
 Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
+
 	vPropertiesList = _PropertiesList()
 	sObject = Utils._PCase(_Type)
 	If IsMissing(pvIndex) Then
@@ -211,6 +215,7 @@ Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
 	
 Exit_Function:
 	Set Properties = vProperty
+	Utils._ResetCalledSub(cstThisSub)
 	Exit Function
 End Function	'	Properties
 

wizards/source/access2base/L10N.xba

@@ -80,6 +80,8 @@ Dim sLocal As String
 				Case "ERR" & ERRWINDOW				:	sLocal = "Current window is not a document"
 				Case "ERR" & ERRCOMPATIBILITY		:	sLocal = "Field '%0' could not be converted due to incompatibility of field types between the respective database systems"
 				Case "ERR" & ERRPRECISION			:	sLocal = "Field '%0' could not be loaded in record #%1 due to capacity shortage"
+				Case "ERR" & ERRMODULENOTFOUND		:	sLocal = "Module '%0' not found in the currently loaded libraries"
+				Case "ERR" & ERRPROCEDURENOTFOUND	:	sLocal = "Procedure '%0' not found in module '%1'"
 				'----------------------------------------------------------------------------------------------------------------------
 				Case "OBJECT"						:	sLocal = "Object"
 				Case "TABLE"						:	sLocal = "Table"
@@ -191,6 +193,8 @@ Dim sLocal As String
 				Case "ERR" & ERRWINDOW				:	sLocal = "La fenêtre courante n'est pas un document"
 				Case "ERR" & ERRCOMPATIBILITY		:	sLocal = "Le champ '%0' n'a pas pu être converti à cause d'une incompatibilité entre les types de champs supportés par les systèmes de bases de données respectifs"
 				Case "ERR" & ERRPRECISION			:	sLocal = "Le champ '%0' n'a pas pu être chargé dans l'enregistrement #%1 par manque de capacité"
+				Case "ERR" & ERRMODULENOTFOUND		:	sLocal = "Le module '%0' est introuvable dans les librairies chargées actuellement"
+				Case "ERR" & ERRPROCEDURENOTFOUND	:	sLocal = "La procédure '%0' est introuvable dans le module '%1'"
 				'----------------------------------------------------------------------------------------------------------------------
 				Case "OBJECT"						:	sLocal = "Objet"
 				Case "TABLE"						:	sLocal = "Table"
@@ -305,6 +309,8 @@ Dim sLocal As String
 				Case "ERR" & ERRWINDOW				:	sLocal = "La ventana actual no es un documento"
 				Case "ERR" & ERRCOMPATIBILITY		:	sLocal = "El campo '%0' no se ha convertido debido a una incompatibilidad de los tipos de campo soportados entre las dos bases de datos"
 				Case "ERR" & ERRPRECISION			:	sLocal = "El campo '%0' no se ha cargado en el registro #%1 por falta de capacidad"
+				Case "ERR" & ERRMODULENOTFOUND		:	sLocal = "Module '%0' not found in the currently loaded libraries"
+				Case "ERR" & ERRPROCEDURENOTFOUND	:	sLocal = "Procedure '%0' not found in module '%1'"
 				'----------------------------------------------------------------------------------------------------------------------
 				Case "OBJECT"						:	sLocal = "Objeto"
 				Case "TABLE"						:	sLocal = "Tabla"

wizards/source/access2base/Root_.xba

@@ -29,7 +29,9 @@ 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 ExcludeA2B			As Boolean
 Private TextSearch			As Object
+Private SearchOptions		As Variant
 Private FindRecord			As Object
 Private StatusBar			As Object
 Private Dialogs				As Object				'	Collection
@@ -51,8 +53,15 @@ Dim vCurrentDoc() As Variant
 	CalledSub = ""
 	DebugPrintShort = True
 	Locale = L10N._GetLocale()
+	ExcludeA2B = True
 	Set Introspection = CreateUnoService("com.sun.star.beans.Introspection")
 	Set TextSearch = CreateUnoService("com.sun.star.util.TextSearch")
+	SearchOptions = New com.sun.star.util.SearchOptions
+	With SearchOptions
+		.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
+		.searchFlag = 0
+		.transliterateFlags = com.sun.star.i18n.TransliterationModules.IGNORE_CASE
+	End With
 	Set FindRecord = Nothing
 	Set StatusBar = Nothing
 	Set Dialogs = New Collection

wizards/source/access2base/Test.xba

@@ -4,6 +4,10 @@
 'Option Compatible
 
 Sub Main
+Dim a, b()
+	_ErrorHandler(False)
+	TraceConsole()
+	exit sub
 End Sub
 
 </script:module>
\ No newline at end of file

wizards/source/access2base/Utils.xba

@@ -913,9 +913,10 @@ Error_Function:
 End Function	'	_ReadFileIntoArray	V1.4.0
 
 REM -----------------------------------------------------------------------------------------------------------------------
-Function _RegexSearch(ByRef psString As String _
+Public Function _RegexSearch(ByRef psString As String _
 						, ByVal psRegex As String _
 						, Optional ByRef plStart As Long _
+						, Optional ByVal bForward As Boolean _
 						) As String
 '	Search is not case-sensitive
 '	Return "" if regex not found, otherwise returns the matching string
@@ -924,26 +925,35 @@ Function _RegexSearch(ByRef psString As 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
+Dim vOptions As Variant	'com.sun.star.util.SearchOptions
+Dim lEnd As Long, vResult As Object
 
 	_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
-		.transliterateFlags = com.sun.star.i18n.TransliterationModules.IGNORE_CASE
-	End With
+	vOptions = _A2B_.SearchOptions
+	vOptions.searchString = psRegex				'	Pattern to be searched
 	oTextSearch.setOptions(vOptions)
 	If IsMissing(plStart) Then plStart = 1
-	If plStart <= 0 Then Exit Function
-	lEnd = Len(psString)
-	vResult = oTextSearch.searchForward(psString, plStart - 1, lEnd)
+	If plStart <= 0 Or plStart > Len(psString) Then Exit Function
+	If IsMissing(bForWard) Then bForward = True
+	If bForward Then
+		lEnd = Len(psString)
+		vResult = oTextSearch.searchForward(psString, plStart - 1, lEnd)
+	Else
+		lEnd = 1
+		vResult = oTextSearch.searchForward(psString, plStart, lEnd - 1)
+	End If
 	With vResult
 		If .subRegExpressions >= 1 Then
-			plStart = .startOffset(0) + 1
-			lEnd = .endOffset(0) + 1
+			'	http://www.openoffice.org/api/docs/common/ref/com/sun/star/util/SearchResult.html
+			Select Case bForward
+				Case True
+					plStart = .startOffset(0) + 1
+					lEnd = .endOffset(0) + 1
+				Case False
+					plStart = .endOffset(0) + 1
+					lEnd = .startOffset(0)
+			End Select
 			_RegexSearch = Mid(psString, plStart, lEnd - plStart)
 		Else
 			plStart = 0
@@ -953,7 +963,7 @@ Dim lEnd As Long
 End Function
 
 REM -----------------------------------------------------------------------------------------------------------------------
-Function _RegisterEventScript(poObject As Object _
+Public Function _RegisterEventScript(poObject As Object _
 								, ByVal psEvent As String _
 								, ByVal psListener As String _
 								, ByVal psScriptCode As String _
@@ -1061,12 +1071,12 @@ End Function	'	Surround
 
 REM -----------------------------------------------------------------------------------------------------------------------
 Public Function _Trim(ByVal psString As String) As String
-'	Remove leading and trailing spaces, remove surrounding square brackets
+'	Remove leading and trailing spaces, remove surrounding square brackets, replace tabs by spaces
 Const cstSquareOpen = "["
 Const cstSquareClose = "]"
 Dim sTrim As String
 	
-	sTrim = Trim(psString)
+	sTrim = Trim(Replace(psString, vbTab, " "))
 	_Trim = sTrim
 	If Len(sTrim) <= 2 Then Exit Function
 	

wizards/source/access2base/acConstants.xba

@@ -385,11 +385,26 @@ Global Const msoBarTypeFloater = 12		'	Floating window
 Global Const msoControlButton = 1		'	Command button
 Global Const msoControlPopup = 10		'	Popup, submenu
 
-REM New Line
+REM New Lines
 REM -----------------------------------------------------------------
+Public Function vbCr() As String	:	vbCr = Chr(13)	:	End Function
+Public Function vbLf() As String	:	vbLf = Chr(10)	:	End Function
 Public Function vbNewLine() As String
 Const cstWindows = 1
-	If GetGuiType() = cstWindows Then vbNewLine = Chr(13) & Chr(10) Else vbNewLine = Chr(10)
+	If GetGuiType() = cstWindows Then vbNewLine = vbCR & vbLF Else vbNewLine = vbLF
 End Function	'	vbNewLine V1.4.0
+Public Function vbTab() As String	:	vbTab = Chr(9)	:	End Function
+
+REM Module types
+REM -----------------------------------------------------------------
+Global Const acClassModule = 1
+Global Const acStandardModule = 0
+
+REM (Module) procedure types
+REM -----------------------------------------------------------------
+Global Const vbext_pk_Get = 1			'	A Property Get procedure
+Global Const vbext_pk_Let = 2			'	A Property Let procedure
+Global Const vbext_pk_Proc = 0			'	A Sub or Function procedure
+Global Const vbext_pk_Set = 3			'	A Property Set procedure
 
 </script:module>
\ No newline at end of file

wizards/source/access2base/script.xlb

@@ -30,4 +30,5 @@
  <library:element library:name="UtilProperty"/>
  <library:element library:name="CommandBar"/>
  <library:element library:name="CommandBarControl"/>
+ <library:element library:name="Module"/>
 </library:library>
\ No newline at end of file