[Libreoffice-commits] core.git: wizards/Package_access2base.mk wizards/source
Jean-Pierre Ledure
jp at ledure.be
Fri Oct 17 08:16:15 PDT 2014
wizards/Package_access2base.mk | 1
wizards/source/access2base/Application.xba | 173 ---------------
wizards/source/access2base/Collect.xba | 8
wizards/source/access2base/Dialog.xba | 4
wizards/source/access2base/Event.xba | 4
wizards/source/access2base/Form.xba | 4
wizards/source/access2base/PropertiesGet.xba | 2
wizards/source/access2base/PropertiesSet.xba | 2
wizards/source/access2base/Root_.xba | 293 +++++++++++++++++++++++++++
wizards/source/access2base/Utils.xba | 29 --
wizards/source/access2base/acConstants.xba | 2
wizards/source/access2base/script.xlb | 3
12 files changed, 322 insertions(+), 203 deletions(-)
New commits:
commit f55a0a54b235d55db3f6e839053be04bfc1ed2d4
Author: Jean-Pierre Ledure <jp at ledure.be>
Date: Fri Oct 17 17:09:20 2014 +0200
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
diff --git a/wizards/Package_access2base.mk b/wizards/Package_access2base.mk
index 7471d1c..3094b21 100644
--- a/wizards/Package_access2base.mk
+++ b/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 \
diff --git a/wizards/source/access2base/Application.xba b/wizards/source/access2base/Application.xba
index 14a2fdd..441e2ee 100644
--- a/wizards/source/access2base/Application.xba
+++ b/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,23 +1185,11 @@ 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)
@@ -1250,85 +1197,6 @@ Trace_Error:
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
diff --git a/wizards/source/access2base/Collect.xba b/wizards/source/access2base/Collect.xba
index ebbf6fc..b8a7223 100644
--- a/wizards/source/access2base/Collect.xba
+++ b/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
diff --git a/wizards/source/access2base/Dialog.xba b/wizards/source/access2base/Dialog.xba
index 00ba51e..6eed82a 100644
--- a/wizards/source/access2base/Dialog.xba
+++ b/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")
diff --git a/wizards/source/access2base/Event.xba b/wizards/source/access2base/Event.xba
index ddf37aa..de6aa2a 100644
--- a/wizards/source/access2base/Event.xba
+++ b/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"
diff --git a/wizards/source/access2base/Form.xba b/wizards/source/access2base/Form.xba
index 37fc0d1..6b7a69a 100644
--- a/wizards/source/access2base/Form.xba
+++ b/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
diff --git a/wizards/source/access2base/PropertiesGet.xba b/wizards/source/access2base/PropertiesGet.xba
index d4df22c..4b3c455 100644
--- a/wizards/source/access2base/PropertiesGet.xba
+++ b/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
diff --git a/wizards/source/access2base/PropertiesSet.xba b/wizards/source/access2base/PropertiesSet.xba
index d60c3ce..b88a5d2 100644
--- a/wizards/source/access2base/PropertiesSet.xba
+++ b/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
diff --git a/wizards/source/access2base/Root_.xba b/wizards/source/access2base/Root_.xba
new file mode 100644
index 0000000..c6728a0
--- /dev/null
+++ b/wizards/source/access2base/Root_.xba
@@ -0,0 +1,293 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
+<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Root_" script:language="StarBasic">REM =======================================================================================================================
+REM === The Access2Base library is a part of the LibreOffice project. ===
+REM === Full documentation is available on http://www.access2base.com ===
+REM =======================================================================================================================
+
+Option Compatible
+Option ClassModule
+
+Option Explicit
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- FOR INTERNAL USE ONLY ---
+REM -----------------------------------------------------------------------------------------------------------------------
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- CLASS ROOT FIELDS ---
+REM -----------------------------------------------------------------------------------------------------------------------
+
+Private ErrorHandler As Boolean
+Private MinimalTraceLevel As Integer
+Private TraceLogs() As Variant
+Private TraceLogCount As Integer
+Private TraceLogLast As Integer
+Private TraceLogMaxEntries As Integer
+Private CalledSub As String
+Private Introspection As Object ' com.sun.star.beans.Introspection
+Private VersionNumber As String ' Actual Access2Base version number
+Private FindRecord As Object
+Private StatusBar As Object
+Private Dialogs As Object ' Collection
+Private TempVars As Object ' Collection
+Private CurrentDoc() As Variant ' Array of document containers - [0] = Base document, [1 ... N] = other documents
+
+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
+End Type
+
+Type DbContainer
+ FormName As String ' name of data-aware form
+ Database As Object ' Database type
+End Type
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- CONSTRUCTORS / DESTRUCTORS ---
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Sub Class_Initialize()
+Dim vCurrentDoc() As Variant
+ 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 Sub ' Constructor
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Private Sub Class_Terminate()
+ Call Class_Initialize()
+End Sub ' Destructor
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Sub Dispose()
+ Call Class_Terminate()
+End Sub ' Explicit destructor
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- CLASS GET/LET/SET PROPERTIES ---
+REM -----------------------------------------------------------------------------------------------------------------------
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- CLASS METHODS ---
+REM -----------------------------------------------------------------------------------------------------------------------
+
+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 ErrorHandler Then On Local Error Goto Error_Sub
+
+ If Not IsArray(CurrentDoc) Then Goto Exit_Sub
+ If UBound(CurrentDoc) < 0 Then Goto Exit_Sub
+ iCurrentDoc = CurrentDocIndex( , False) ' False prevents error raising if not found
+ If iCurrentDoc < 0 Then GoTo Exit_Sub ' If not found ignore
+
+ vDocContainer = CurrentDocument(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(CalledSub) & " " & .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
+
+Exit_Sub:
+ Exit Sub
+Error_Sub:
+ TraceError(TRACEABORT, Err, CalledSub, Erl, False) ' No error message addressed to the user, only stored in console
+ GoTo Exit_Sub
+End Sub ' CloseConnection
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function CurrentDb() As Object
+' Returns _A2B_.CurrentDocument().Database as an object to allow access to its properties
+
+Dim iCurrentDoc As Integer
+
+ Set CurrentDb = Nothing
+
+ If Not IsArray(CurrentDoc) Then Goto Exit_Function
+ If UBound(CurrentDoc) < 0 Then Goto Exit_Function
+ iCurrentDoc = CurrentDocIndex(, False) ' False = no abort
+ If iCurrentDoc >= 0 Then
+ If UBound(CurrentDoc(iCurrentDoc).DbContainers) >= 0 Then Set CurrentDb = CurrentDoc(iCurrentDoc).DbContainers(0).Database
+ End If
+
+Exit_Function:
+ Exit Function
+End Function ' CurrentDb
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function CurrentDocIndex(Optional pvURL As Variant, Optional pbAbort As Variant) As Integer
+' Returns the entry in 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
+ CurrentDocIndex = -1
+
+ 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
+ CurrentDocIndex = 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
+ CurrentDocIndex = 0
+ End If
+
+Exit_Function:
+ Exit Function
+Trace_Error:
+ If IsMissing(pbAbort) Then pbAbort = True
+ If pbAbort Then TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0, 1) Else CurrentDocIndex = -1
+ Goto Exit_Function
+End Function ' CurrentDocIndex
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function CurrentDocument(ByVal Optional piDocIndex As Integer) As Variant
+' Returns the CurrentDoc(...) referring to the current document or to the argument
+
+Dim iDocIndex As Integer
+ If IsMissing(piDocIndex) Then iDocIndex = CurrentDocIndex() Else iDocIndex = piDocIndex
+ If iDocIndex >= 0 And iDocIndex <= UBound(CurrentDoc) Then Set CurrentDocument = CurrentDoc(iDocIndex) Else Set CurrentDocument = Nothing
+
+End Function
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Sub Dump()
+' For debugging purposes
+Dim i As Integer, j As Integer, vCurrentDoc As Variant
+ On Local Error Resume Next
+
+ 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)
+ If Not IsNull(vCurrentDoc) Then
+ 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
+ End If
+ Next i
+ End If
+
+End Sub
+
+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 = Dialogs.Item(UCase(psName))
+ Case COLLTEMPVARS
+ Set oItem = 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
+
+REM -----------------------------------------------------------------------------------------------------------------------
+REM --- PRIVATE FUNCTIONS ---
+REM -----------------------------------------------------------------------------------------------------------------------
+
+REM -----------------------------------------------------------------------------------------------------------------------
+Public Function _CurrentDb(ByVal Optional piDocEntry As Integer, ByVal Optional piDbEntry As Integer) As Variant
+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 IsMissing(piDocEntry) Then
+ Set odbDatabase = CurrentDb()
+ Else
+ 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 If
+ If IsNull(odbDatabase) Then GoTo Trace_Error
+
+Exit_Function:
+ Set _CurrentDb = odbDatabase
+ Exit Function
+Trace_Error:
+ TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0, 1)
+ Goto Exit_Function
+End Function ' _CurrentDb
+</script:module>
\ No newline at end of file
diff --git a/wizards/source/access2base/Utils.xba b/wizards/source/access2base/Utils.xba
index ace29d9..0f95803 100644
--- a/wizards/source/access2base/Utils.xba
+++ b/wizards/source/access2base/Utils.xba
@@ -163,29 +163,6 @@ Public Function _DecimalPoint() As String
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
' Adapted from http://wiki.services.openoffice.org/wiki/Documentation/DevGuide/Extensions/Location_of_Installed_Extensions
@@ -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
diff --git a/wizards/source/access2base/acConstants.xba b/wizards/source/access2base/acConstants.xba
index 69e6e49..5f533fe 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.0g"
+Global Const Access2Base_Version = "1.1.0h"
REM AcCloseSave
REM -----------------------------------------------------------------
diff --git a/wizards/source/access2base/script.xlb b/wizards/source/access2base/script.xlb
index 78efee9..3bdae29 100644
--- a/wizards/source/access2base/script.xlb
+++ b/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
More information about the Libreoffice-commits
mailing list