diff options
Diffstat (limited to 'wizards')
| -rw-r--r-- | wizards/source/access2base/Application.xba | 79 | ||||
| -rw-r--r-- | wizards/source/access2base/Database.xba | 5 | ||||
| -rw-r--r-- | wizards/source/access2base/Form.xba | 11 | ||||
| -rw-r--r-- | wizards/source/access2base/acConstants.xba | 2 |
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 ----------------------------------------------------------------- |