[Libreoffice-commits] core.git: wizards/source
Jean-Pierre Ledure
jp at ledure.be
Sat Sep 13 06:17:55 PDT 2014
wizards/source/access2base/Application.xba | 79 ++++++++++++++++++++++++++---
wizards/source/access2base/Database.xba | 5 +
wizards/source/access2base/Form.xba | 11 +++-
wizards/source/access2base/acConstants.xba | 2
4 files changed, 87 insertions(+), 10 deletions(-)
New commits:
commit bc5cdd24136a0d62659a6fe1e3f14cc22ad0ff90
Author: Jean-Pierre Ledure <jp at ledure.be>
Date: Sat Sep 13 15:08:29 2014 +0200
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
diff --git a/wizards/source/access2base/Application.xba b/wizards/source/access2base/Application.xba
index 9a994b1..3dbf894 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 c5576f9..d6b84c1 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 a787dfe..37fc0d1 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 4876d1c..793f06f 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 -----------------------------------------------------------------
More information about the Libreoffice-commits
mailing list