Kaydet (Commit) bc5cdd24 authored tarafından Jean-Pierre Ledure's avatar Jean-Pierre Ledure

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
üst 2c3844a1
......@@ -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
......@@ -387,6 +388,56 @@ Error_Function:
GoTo Exit_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)
......@@ -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
......
......@@ -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
......
......@@ -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:
......
......@@ -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 -----------------------------------------------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment