Access2Base - Introduction of CloseConnection method

The invocation of CloseConnection has next effects:
    All the recordsets related to a database linked to the current document are closed.
    The database object(s) is(are) released.

Change-Id: I845b27acb8469c4dea0dc3bc20b912ab123d06cf

4 files changed, 87 insertions, 10 deletions

diff --git a/wizards/source/access2base/Application.xba b/wizards/source/access2base/Application.xba
index 9a994b117aae..3dbf8945e81c 100644
--- a/wizards/source/access2base/Application.xba
+++ b/wizards/source/access2base/Application.xba
@@ -157,6 +157,7 @@ End Type
 
 Type DocContainer
 	Document			As Object				'	com.sun.star.comp.dba.ODatabaseDocument	or SwXTextDocument or ScModelObj
+	Active				As Boolean
 	DbConnect			As Integer				'	DBCONNECTxxx constants
 	URL					As String
 	DbContainers()		As Variant				'	One entry by (data-aware) form
@@ -388,6 +389,56 @@ Error_Function:
 End Function		'	AllForms	V0.9.0
 
 REM -----------------------------------------------------------------------------------------------------------------------
+Public Sub CloseConnection ()
+				
+'	Close all connections established by current document to free memory.
+'	- 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
+	
+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 -----------------------------------------------------------------------------------------------------------------------
 Public Function Controls(ByVal Optional pvObject As Variant, Optional ByVal pvIndex As Variant) As Variant
 '	Return an object of type Control indicated by either its index (integer) or its name (CASE-INSENSITIVE string)
 '	The 1st argument pvObject can be either
@@ -447,7 +498,9 @@ Dim i As Integer, bFound As Boolean, sURL As String, iCurrentDoc As Integer, oCu
 		If Not IsArray(.CurrentDoc) Then Goto Exit_Function
 		If UBound(.CurrentDoc) < 0 Then Goto Exit_Function
 		iCurrentDoc = _CurrentDoc(, False)
-		If iCurrentDoc >= 0 Then Set CurrentDb = .CurrentDoc(iCurrentDoc).DbContainers(0).Database
+		If iCurrentDoc >= 0 Then
+			If UBound(.CurrentDoc(iCurrentDoc).DbContainers) >= 0 Then Set CurrentDb = .CurrentDoc(iCurrentDoc).DbContainers(0).Database
+		End If
 	End With
 
 Exit_Function:
@@ -789,7 +842,7 @@ Const cstThisSub = "OpenConnection"
 					bFound = False
 					For i = 1 To UBound(vCurrentDoc)
 						If Not IsEmpty(vCurrentDoc(i)) Then
-							If vCurrentDoc(i).URL = .URL Then
+							If vCurrentDoc(i).Active And vCurrentDoc(i).URL = .URL Then
 								iCurrent = i
 								bFound = True
 								Exit For
@@ -807,6 +860,7 @@ Const cstThisSub = "OpenConnection"
 	'	Initialize future entry
 	Set vDocContainer = New DocContainer
 	Set vDocContainer.Document = oComponent
+	vDocContainer.Active = True
 	vDocContainer.URL = oComponent.URL
 	'	Initialize each DbContainer entry
 	vDbContainers() = Array()
@@ -1139,18 +1193,20 @@ Trace_Error:
 End Function		'	_CurrentDb	V1.1.0
 
 REM -----------------------------------------------------------------------------------------------------------------------
-Public Function _CurrentDoc(Optional pvURL As String, Optional pbAbort As Boolean) As Integer
+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 IsMissing(pvURL) Then						'	Not on 1 single line ?!?
 				If Utils._hasUNOProperty(ThisComponent, "URL") Then
 					sURL = ThisComponent.URL
 				Else
@@ -1159,14 +1215,25 @@ Dim i As Integer, bFound As Boolean, sURL As String
 			Else
 				sURL = pvURL	'	To support the SelectObject action
 			End If
-			If .CurrentDoc(i).URL = sURL Then
+			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 Not IsNull(.CurrentDoc(0)) Then _CurrentDoc = 0 Else GoTo Trace_Error
+			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 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 .Document.URL <> ThisComponent.Parent.URL Then Goto Trace_Error
+				End If
+			End With
+			_CurrentDoc = 0
 		End If
 	End With
 
diff --git a/wizards/source/access2base/Database.xba b/wizards/source/access2base/Database.xba
index c5576f9cfa15..d6b84c1ce163 100644
--- a/wizards/source/access2base/Database.xba
+++ b/wizards/source/access2base/Database.xba
@@ -50,12 +50,15 @@ End Sub		'	Constructor
 REM -----------------------------------------------------------------------------------------------------------------------
 Private Sub Class_Terminate()
 	On Local Error Resume Next
-	If _DbConnect = DBCONNECTANY Then
+	Call CloseAllRecordsets()
+	If _DbConnect <> DBCONNECTANY Then
 		If Not IsNull(Connection) Then
 			Connection.close()
 			Connection.dispose()
 			Set Connection = Nothing
 		End If
+	Else
+		mClose()
 	End If
 	Call Class_Initialize()
 End Sub		'	Destructor
diff --git a/wizards/source/access2base/Form.xba b/wizards/source/access2base/Form.xba
index a787dfec6257..37fc0d121168 100644
--- a/wizards/source/access2base/Form.xba
+++ b/wizards/source/access2base/Form.xba
@@ -51,6 +51,10 @@ End Sub		'	Destructor
 
 REM -----------------------------------------------------------------------------------------------------------------------
 Public Sub Dispose()
+Dim ofForm As Object
+	If Not IsLoaded(True) Then
+		If Not IsNull(DatabaseForm) Then DatabaseForm.Dispose()
+	End If
 	Call Class_Terminate()
 End Sub		'	Explicit destructor
 
@@ -138,12 +142,14 @@ Property Let Height(ByVal pvValue As Variant)
 End Property	'	Height (set)
 
 REM -----------------------------------------------------------------------------------------------------------------------
-Function IsLoaded() As Boolean
+Function IsLoaded(ByVal Optional pbForce As Boolean) As Boolean
 'Return True if form open
+'pbForce = True forbids bypass on value of _IsLoaded
 
 	If _ErrorHandler() Then On Local Error Goto Error_Function
 	Utils._SetCalledSub("Form.getIsLoaded")
-	If _IsLoaded Then			'	For performance reasons, a form object, once detected as loaded, is presumed remaining loaded
+	If IsMissing(pbForce) Then pbForce = False
+	If ( Not pbForce ) And _IsLoaded Then			'	For performance reasons, a form object, once detected as loaded, is presumed remaining loaded. Except if pbForce = True
 		IsLoaded = True
 		Goto Exit_Function
 	End If
@@ -320,6 +326,7 @@ Dim oDatabase As Object, oController As Object
 
 	Set oController = oDatabase.Document.getFormDocuments.getByName(_Name)
 	oController.close()
+	Dispose()
 	mClose = True
 
 Exit_Function:
diff --git a/wizards/source/access2base/acConstants.xba b/wizards/source/access2base/acConstants.xba
index 4876d1c682fe..793f06ff4725 100644
--- a/wizards/source/access2base/acConstants.xba
+++ b/wizards/source/access2base/acConstants.xba
@@ -8,7 +8,7 @@ REM ============================================================================
 Option Explicit
 
 REM Access2Base -----------------------------------------------------
-Global Const Access2Base_Version = "1.1.0e"
+Global Const Access2Base_Version = "1.1.0f"
 
 REM AcCloseSave
 REM -----------------------------------------------------------------