Access2Base - Internal redesign of root structure into a separate class module

Redesign of CurrentDb, CurrentDoc interfaces.
Creation of new Root_.xba class module.
Console logs, TempVars and Dialog collections are unchanged.

Change-Id: I573a75e8fb54b277aef84d4518cc8e5cc21d7270

wizards/Package_access2base.mk

@@ -43,6 +43,7 @@ $(eval $(call gb_Package_add_files,wizards_basicsrvaccess2base,$(LIBO_SHARE_FOLD
 	PropertiesSet.xba \
 	Property.xba \
 	Recordset.xba \
+	Root_.xba \
 	script.xlb \
 	SubForm.xba \
 	TempVar.xba \

wizards/source/access2base/Application.xba

@@ -312,9 +312,9 @@ Dim iIndex As Integer, vAllForms As Variant
 	End If
 
 Dim iCurrentDoc As Integer, vCurrentDoc As Variant, oForms As Variant, oCounter As Variant, oFormsCollection As Object
-	iCurrentDoc = Application._CurrentDoc()
+	iCurrentDoc = _A2B_.CurrentDocIndex()
 	If iCurrentDoc >= 0 Then
-		vCurrentDoc = _A2B_.CurrentDoc(iCurrentDoc)
+		vCurrentDoc = _A2B_.CurrentDocument(iCurrentDoc)
 	Else
 		Goto Exit_Function
 	End If
@@ -398,47 +398,16 @@ Public Sub CloseConnection ()
 '	- if Base document => close the one concerned database connection
 '	- if non-Base documents => close the connections of each individual standalone form
 
-Dim i As Integer, iCurrentDoc As Integer
-Dim vDbContainer As Variant, vDbContainers() As Variant, vDocContainer As Variant
-
 	If IsEmpty(_A2B_) Then Goto Exit_Sub
 	
-	If _ErrorHandler() Then On Local Error Goto Error_Sub
 Const cstThisSub = "CloseConnection"
 	Utils._SetCalledSub(cstThisSub)
 
-	With _A2B_
-		If Not IsArray(.CurrentDoc) Then Goto Exit_Sub
-		If UBound(.CurrentDoc) < 0 Then Goto Exit_Sub
-		iCurrentDoc = _CurrentDoc( , False)			'	False prevents error raising if not found
-		If iCurrentDoc < 0 Then GoTo Exit_Sub		'	If not found ignore
-		
-		vDocContainer = .CurrentDoc(iCurrentDoc)
-		With vDocContainer
-			If Not .Active Then GoTo Exit_Sub		'	e.g. if successive calls to CloseConnection()
-			For i = 0 To UBound(.DbContainers)
-				If Not IsNull(.DbContainers(i).Database) Then
-					.DbContainers(i).Database.Dispose()
-					Set .DbContainers(i).Database = Nothing
-				End If
-				TraceLog(TRACEANY, UCase(cstThisSub) & " " & .URL & Iif(i = 0, "", " Form=" & .DbContainers(i).FormName), False)
-				Set .DbContainers(i) = Nothing
-			Next i
-			.DbContainers = Array()
-			.URL = ""
-			.DbConnect = 0
-			.Active = False
-			Set .Document = Nothing
-		End With
-		.CurrentDoc(iCurrentDoc) = vDocContainer
-	End With
+	Call _A2B_.CloseConnection()
 	
 Exit_Sub:
 	Utils._ResetCalledSub(cstThisSub)
 	Exit Sub
-Error_Sub:
-	TraceError(TRACEABORT, Err, cstThisSub, Erl, False)		'	No error message addressed to the user, only stored in console
-	GoTo Exit_Sub
 End Sub			'	CloseConnection		V1.2.0
 
 REM -----------------------------------------------------------------------------------------------------------------------
@@ -486,25 +455,15 @@ Error_Function:
 End Function		'	Controls	V0.9.0
 
 REM -----------------------------------------------------------------------------------------------------------------------
-Public Function CurrentDb(Optional pvURL As String) As Object
-'	Returns _A2B_.CurrentDoc(.).Database as an object to allow access to its properties
-'	Parameter only for internal use
+Public Function CurrentDb() As Object
+'	Returns _A2B_.CurrentDocument().Database as an object to allow access to its properties
 
 Const cstThisSub = "CurrentDb"
 	Utils._SetCalledSub(cstThisSub)
-Dim i As Integer, bFound As Boolean, sURL As String, iCurrentDoc As Integer, oCurrentDoc As Object
 
-	bFound = False
 	Set CurrentDb = Nothing
 	If IsEmpty(_A2B_) Then GoTo Exit_Function
-	With _A2B_
-		If Not IsArray(.CurrentDoc) Then Goto Exit_Function
-		If UBound(.CurrentDoc) < 0 Then Goto Exit_Function
-		iCurrentDoc = _CurrentDoc(, False)
-		If iCurrentDoc >= 0 Then
-			If UBound(.CurrentDoc(iCurrentDoc).DbContainers) >= 0 Then Set CurrentDb = .CurrentDoc(iCurrentDoc).DbContainers(0).Database
-		End If
-	End With
+	Set CurrentDb = _A2B_.CurrentDb()
 
 Exit_Function:
 	Utils._ResetCalledSub(cstThisSub)
@@ -1165,7 +1124,7 @@ Const cstByName = 2
 			If pvIndex < 0 Or pvIndex >= _A2B_.TempVars.Count Then Goto Trace_Error_Index
 			Set vTempVars = _A2B_.TempVars.Item(pvIndex + 1)		'	Builtin collections start at 1
 		Case cstByName
-			bFound = _hasItem(COLLTEMPVARS, pvIndex)
+			bFound = _A2B_.hasItem(COLLTEMPVARS, pvIndex)
 			If Not bFound Then Goto Trace_NotFound
 			vTempVars = _A2B_.TempVars.Item(UCase(pvIndex))
 	End Select
@@ -1226,108 +1185,17 @@ Public Function _CurrentDb(ByVal Optional piDocEntry As Integer, ByVal Optional
 REM Without arguments same as CurrentDb() except that it generates an error if database not connected (internal use)
 REM With 2 arguments return the corresponding entry in Root
 
-Dim odbDatabase As Variant
 	If IsEmpty(_A2B_) Then GoTo Trace_Error
-	If IsMissing(piDocEntry) Then
-		Set odbDatabase = Application.CurrentDb()
-	Else
-		With _A2B_
-			If Not IsArray(.CurrentDoc) Then Goto Trace_Error
-			If piDocEntry < 0 Or piDbEntry < 0 Then Goto Trace_Error
-			If piDocEntry > UBound(.CurrentDoc) Then Goto Trace_Error
-			If piDbEntry > UBound(.CurrentDoc(piDocEntry).DbContainers) Then Goto Trace_Error
-			Set odbDatabase = .CurrentDoc(piDocEntry).DbContainers(piDbEntry).Database
-		End With
-	End If
-	If IsNull(odbDatabase) Then GoTo Trace_Error
+	If IsMissing(piDocEntry)	Then Set _CurrentDb = Application.CurrentDb() _
+								Else Set _CurrentDb = _A2B_._CurrentDb(piDocEntry, piDbEntry)
 
 Exit_Function:
-	Set _CurrentDb = odbDatabase
 	Exit Function	
 Trace_Error:
 	TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0, 1)
 	Goto Exit_Function
 End Function		'	_CurrentDb	V1.1.0
 
-REM -----------------------------------------------------------------------------------------------------------------------
-Public Function _CurrentDoc(Optional pvURL As Variant, Optional pbAbort As Variant) As Integer
-'	Returns the entry in _A2B_.CurrentDoc(...) referring to the current document
-
-Dim i As Integer, bFound As Boolean, sURL As String
-Const cstBase = "com.sun.star.comp.dba.ODatabaseDocument"
-
-	bFound = False
-	_CurrentDoc = -1
-	If IsEmpty(_A2B_) Then GoTo Trace_Error
-	With _A2B_
-		If Not IsArray(.CurrentDoc) Then Goto Trace_Error
-		If UBound(.CurrentDoc) < 0 Then Goto Trace_Error
-		For i = 1 To UBound(.CurrentDoc)					'	[0] reserved to database .odb document
-			If IsMissing(pvURL) Then						'	Not on 1 single line ?!?
-				If Utils._hasUNOProperty(ThisComponent, "URL") Then
-					sURL = ThisComponent.URL
-				Else
-					Exit For	'	f.i. ThisComponent = Basic IDE ...
-				End If
-			Else
-				sURL = pvURL	'	To support the SelectObject action
-			End If
-			If .CurrentDoc(i).Active And .CurrentDoc(i).URL = sURL Then
-				_CurrentDoc = i
-				bFound = True
-				Exit For
-			End If
-		Next  i
-		If Not bFound Then
-			If IsNull(.CurrentDoc(0)) Then GoTo Trace_Error
-			With .CurrentDoc(0)
-				If Not .Active Then GoTo Trace_Error
-				If IsNull(.Document) Then GoTo Trace_Error
-				If Not  Utils._hasUNOProperty(ThisComponent, "URL") Then Goto Trace_Error
-				If Utils._ImplementationName(ThisComponent) <> cstBase Or .Document.URL <> ThisComponent.URL Then	'	Give the parent a try
-					If Not  Utils._hasUNOProperty(ThisComponent, "Parent") Then Goto Trace_Error
-					If IsNull(ThisComponent.Parent) Then Goto Trace_Error
-					If Utils._ImplementationName(ThisComponent.Parent) <> cstBase Then Goto Trace_Error
-					If Not  Utils._hasUNOProperty(ThisComponent.Parent, "URL") Then Goto Trace_Error
-					If .Document.URL <> ThisComponent.Parent.URL Then Goto Trace_Error
-				End If
-			End With
-			_CurrentDoc = 0
-		End If
-	End With
-
-Exit_Function:
-	Exit Function
-Trace_Error:
-	If IsMissing(pbAbort) Then pbAbort = True
-	If pbAbort Then TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0, 1) Else _CurrentDoc = -1
-	Goto Exit_Function
-End Function	'	_CurrentDoc		V1.1.0
-
-REM -----------------------------------------------------------------------------------------------------------------------
-Public Function _hasItem(psCollType As String, ByVal psName As String) As Boolean
-'	Return True if psName if in the collection
-
-Dim oItem As Object
-	On Local Error Goto Error_Function		'	Whatever ErrorHandler !
-
-	_hasItem = True
-	Select Case psCollType
-		Case COLLALLDIALOGS
-			Set oItem = _A2B_.Dialogs.Item(UCase(psName))
-		Case COLLTEMPVARS
-			Set oItem = _A2B_.TempVars.Item(UCase(psName))
-		Case Else
-			_hasItem = False
-	End Select
-
-Exit_Function:
-	Exit Function
-Error_Function:		'	Item by key aborted
-	_hasItem = False
-	GoTo Exit_Function
-End Function	'	_hasItem	V1.2.0
-
 REM -----------------------------------------------------------------------------------------------------------------------
 Private Function _NewBar() As Object
 '	Close current status bar, if any, and initialize new one
@@ -1369,28 +1237,7 @@ Public Sub _RootInit(Optional ByVal pbForce As Boolean)
 
 Dim vRoot As Root, vCurrentDoc() As Variant
 	If IsMissing(pbForce) Then pbForce = False
-	If IsEmpty(_A2B_) Or pbForce Then
-		_A2B_ = vRoot
-		With _A2B_
-			.VersionNumber = Access2Base_Version
-			.ErrorHandler = True
-			.MinimalTraceLevel = 0
-			.TraceLogs() = Array()
-			.TraceLogCount = 0
-			.TraceLogLast = 0
-			.TraceLogMaxEntries = 0
-			.CalledSub = ""
-			.Introspection = Nothing
-			Set .FindRecord = Nothing
-			Set .StatusBar = Nothing
-			Set .Dialogs = New Collection
-			Set .TempVars = New Collection
-			vCurrentDoc() = Array()
-			ReDim vCurrentDoc(0 To 0)
-			Set vCurrentDoc(0) = Nothing
-			Set .CurrentDoc() = vCurrentDoc()
-		End With
-	End If
+	If IsEmpty(_A2B_) Or pbForce Then _A2B_ = New Root_
 	
 End Sub		'	_RootInit	V1.1.0
 </script:module>
\ No newline at end of file

wizards/source/access2base/Collect.xba

@@ -187,7 +187,7 @@ Dim vObject As Variant, oTempVar As Object
 
 	Select Case _CollType
 		Case COLLTABLEDEFS
-			If Not Utils._CheckArgument(pvObject, 1, vbObject) Then Goto Exit_Function
+			If Not Utils._CheckArgument(pvNew, 1, vbObject) Then Goto Exit_Function
 			Set vObject = pvNew
 			With vObject
 				Set odbDatabase = ._ParentDatabase
@@ -206,7 +206,7 @@ Dim vObject As Variant, oTempVar As Object
 			If Not Utils._CheckArgument(pvNew, 1, vbString) Then Goto Exit_Function
 			If pvNew = "" Then Goto Error_Name
 			If IsMissing(pvValue) Then Call _TraceArguments()
-			If Application._hasItem(COLLTEMPVARS, pvNew) Then Goto Error_Name
+			If _A2B_.hasItem(COLLTEMPVARS, pvNew) Then Goto Error_Name
 			Set oTempVar = New TempVar
 			oTempVar._Name = pvNew
 			oTempVar._Value = pvValue
@@ -252,7 +252,7 @@ Dim odbDatabase As Object, oColl As Object, vName As Variant
 
 	Select Case _CollType
 		Case COLLTABLEDEFS, COLLQUERYDEFS
-			If Application._CurrentDoc <> 0 Then Goto Error_NotApplicable 
+			If _A2B_.CurrentDocIndex() <> 0 Then Goto Error_NotApplicable 
 			Set odbDatabase = Application._CurrentDb()
 			If odbDatabase._DbConnect <> DBCONNECTBASE Then Goto Error_NotApplicable
 			If _CollType = COLLTABLEDEFS Then Set oColl = odbDatabase.Connection.getTables() Else Set oColl = odbDatabase.Connection.getQueries()
@@ -319,7 +319,7 @@ Dim oColl As Object, vName As Variant
 
 	Select Case _CollType
 		Case COLLTEMPVARS
-			If Not _hasItem(COLLTEMPVARS, pvName) Then Goto Error_Name
+			If Not _A2B_.hasItem(COLLTEMPVARS, pvName) Then Goto Error_Name
 			_A2B_.TempVars.Remove(UCase(pvName))
 		Case Else
 			Goto Error_NotApplicable

wizards/source/access2base/Dialog.xba

@@ -487,7 +487,7 @@ Dim oStart As Object
 		Start = True
 		Set UnoDialog = oStart
 		With _A2B_
-			If Application._hasItem(COLLALLDIALOGS, _Name) Then .Dialogs.Remove(_Name)		'	Inserted to solve errors, when aborts between start and terminate
+			If .hasItem(COLLALLDIALOGS, _Name) Then .Dialogs.Remove(_Name)		'	Inserted to solve errors, when aborts between start and terminate
 			.Dialogs.Add(UnoDialog, UCase(_Name))
 		End With
 	End If
@@ -574,7 +574,7 @@ Dim vEMPTY As Variant
 		Case UCase("Height")
 			_PropertyGet = UnoDialog.getPosSize().Height
 		Case UCase("IsLoaded")
-			_PropertyGet = Application._hasItem(COLLALLDIALOGS, _Name)
+			_PropertyGet = _A2B_.hasItem(COLLALLDIALOGS, _Name)
 		Case UCase("Name")
 			_PropertyGet = _Name
 		Case UCase("ObjectType")

wizards/source/access2base/Event.xba

@@ -319,9 +319,9 @@ Const cstDatabaseForm = "com.sun.star.comp.forms.ODatabaseForm"
 		Case Else
 	End Select
 	
-	iCurrentDoc = Application._CurrentDoc(, False)
+	iCurrentDoc = _A2B_.CurrentDocIndex(, False)
 	If iCurrentDoc < 0 Then Goto Exit_Function
-	Set oDoc = _A2B_.CurrentDoc(iCurrentDoc)
+	Set oDoc = _A2B_.CurrentDocument(iCurrentDoc)
 
 	'	To manage 2x triggers of "Before record action" form event
 	If _EventType = "ROWCHANGEEVENT" And sImplementation <> "com.sun.star.comp.forms.ODatabaseForm" Then _Recommendation = "IGNORE"

wizards/source/access2base/Form.xba

@@ -157,7 +157,7 @@ Function IsLoaded(ByVal Optional pbForce As Boolean) As Boolean
 	
 Dim oDoc As Object, oDatabase As Object, oEnum As Object, oDesk As Object, oComp As Object, bFound As Boolean
 Dim i As Integer
-	Set oDoc = _A2B_.CurrentDoc(Application._CurrentDoc())
+	Set oDoc = _A2B_.CurrentDocument()
 	Select Case oDoc.DbConnect
 		Case DBCONNECTBASE
 			Set oDesk = CreateUnoService("com.sun.star.frame.Desktop")
@@ -608,7 +608,7 @@ Dim oDoc As Object, oFormsCollection As Object, oDatabase As Object
 	_Name = psName
 	_Shortcut = "Forms!" & Utils._Surround(psName)
 	If IsLoaded Then
-		Set oDoc = _A2B_.CurrentDoc(Application._CurrentDoc())
+		Set oDoc = _A2B_.CurrentDocument()
 		Select Case oDoc.DbConnect
 			Case DBCONNECTBASE
 				If Not IsNull(Component.CurrentController) Then		'	A form opened then closed afterwards keeps a Component attribute

wizards/source/access2base/PropertiesGet.xba

@@ -407,7 +407,7 @@ Dim oDoc As Object
 	If UBound(sComponents) = 0 Then Goto Trace_Error
 	If Not Utils._InList(UCase(sComponents(0)), Array("FORMS", "DIALOGS", "TEMPVARS")) Then Goto Trace_Error
 	If sComponents(1) = "0" Or Left(sComponents(1), 2) = "0." Then
-		Set oDoc = _A2B_.CurrentDoc(Application._CurrentDoc())
+		Set oDoc = _A2B_.CurrentDocument()
 		If oDoc.DbConnect = DBCONNECTFORM Then sComponents(1) = oDoc.DbContainers(0).FormName Else Goto Trace_Error
 	End If
 

wizards/source/access2base/PropertiesSet.xba

@@ -376,7 +376,7 @@ Private Function _setProperty(pvItem As Variant, ByVal psProperty As String, ByV
 	If _ErrorHandler() Then On Local Error Goto Error_Function
 
 'pvItem must be an object and have the requested property
-	If Not Utils._CheckArgument(pvIndex, 1, vbObject) Then Goto Exit_Function
+	If Not Utils._CheckArgument(pvItem, 1, vbObject) Then Goto Exit_Function
 'Check Index argument
 	If Not IsMissing(pvIndex) Then
 		If Not Utils._CheckArgument(pvIndex, 4, Utils._AddNumeric()) Then Goto Exit_Function

wizards/source/access2base/Utils.xba

@@ -162,29 +162,6 @@ Public Function _DecimalPoint() As String
 	_DecimalPoint = Mid(Format(0, "0.0"), 2, 1)
 End Function
 
-REM -----------------------------------------------------------------------------------------------------------------------
-Public Function _Dump_A2B() As Variant
-'	For debugging purposes
-Dim i As Integer, j As Integer, vCurrentDoc As Variant
-	On Local Error Resume Next
-		With _A2B_
-			DebugPrint "Version", .VersionNumber
-			DebugPrint "TraceLevel", .MinimalTraceLevel
-			DebugPrint "TraceCount", .TraceLogCount
-			DebugPrint "CalledSub", .CalledSub
-			If IsArray(.CurrentDoc) Then
-				For i = 0 To UBound(.CurrentDoc)
-					vCurrentDoc = .CurrentDoc(i)
-					DebugPrint i, "URL", vCurrentDoc.URL
-					For j = 0 To UBound(vCurrentDoc.DbContainers)
-						DebugPrint i, j, "Form", vCurrentDoc.DbContainers(j).FormName
-						DebugPrint i, j, "Database", vCurrentDoc.DbContainers(j).Database.Title
-					Next j
-				Next i
-			End If
-		End With
-End Function
-
 REM -----------------------------------------------------------------------------------------------------------------------
 Private Function _ExtensionLocation() As String
 '	Return the URL pointing to the location where OO installed the Access2Base extension
@@ -491,7 +468,7 @@ Dim oDoc As Object, oForms As Variant
 		Select Case ._Type
 			Case OBJFORM
 				If ._Name <> "" Then		'	Check validity of form name
-					Set oDoc = _A2B_.CurrentDoc(Application._CurrentDoc())
+					Set oDoc = _A2B_.CurrentDocument()
 					If oDoc.DbConnect = DBCONNECTFORM Then
 						bPseudoExists = True
 					Else
@@ -503,7 +480,7 @@ Dim oDoc As Object, oForms As Variant
 				If ._DbConnect = DBCONNECTFORM Then bPseudoExists = True Else bPseudoExists = .Document.CurrentController.IsConnected
 			Case OBJDIALOG
 				If ._Name <> "" Then		'	Check validity of dialog name
-					bPseudoExists = ( Application._hasItem(COLLALLDIALOGS, ._Name) )
+					bPseudoExists = ( _A2B_.hasItem(COLLALLDIALOGS, ._Name) )
 				End If
 			Case OBJCOLLECTION
 				bPseudoExists = True
@@ -535,7 +512,7 @@ Dim oDoc As Object, oForms As Variant
 				bPseudoExists = ( ._Name <> "" And Not IsNull(.Column) )
 			Case OBJTEMPVAR
 				If ._Name <> "" Then		'	Check validity of tempvar name
-					bPseudoExists = ( Application._hasItem(COLLTEMPVARS, ._Name) )
+					bPseudoExists = ( _A2B_.hasItem(COLLTEMPVARS, ._Name) )
 				End If
 			Case Else
 		End Select

wizards/source/access2base/acConstants.xba

@@ -8,7 +8,7 @@ REM ============================================================================
 Option Explicit
 
 REM Access2Base -----------------------------------------------------
-Global Const Access2Base_Version = "1.1.0g"
+Global Const Access2Base_Version = "1.1.0h"
 
 REM AcCloseSave
 REM -----------------------------------------------------------------

wizards/source/access2base/script.xlb

@@ -26,4 +26,5 @@
  <library:element library:name="DataDef"/>
  <library:element library:name="Recordset"/>
  <library:element library:name="TempVar"/>
-</library:library>
+ <library:element library:name="Root_"/>
+</library:library>
\ No newline at end of file