From f55a0a54b235d55db3f6e839053be04bfc1ed2d4 Mon Sep 17 00:00:00 2001 From: Jean-Pierre Ledure Date: Fri, 17 Oct 2014 17:09:20 +0200 Subject: 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 --- 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(-) create mode 100644 wizards/source/access2base/Root_.xba (limited to 'wizards') diff --git a/wizards/Package_access2base.mk b/wizards/Package_access2base.mk index 7471d1ce8a07..3094b215868b 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 14a2fdd9ccee..441e2ee54698 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,108 +1185,17 @@ 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) Goto Exit_Function 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 \ No newline at end of file diff --git a/wizards/source/access2base/Collect.xba b/wizards/source/access2base/Collect.xba index ebbf6fcc14b3..b8a722318cfd 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 00ba51ec933f..6eed82aee805 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 ddf37aac3da4..de6aa2a6e4c6 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 37fc0d121168..6b7a69a90c77 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 d4df22c23b6e..4b3c4552669a 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 d60c3cee12a3..b88a5d2ca8b1 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 000000000000..c6728a0841ee --- /dev/null +++ b/wizards/source/access2base/Root_.xba @@ -0,0 +1,293 @@ + + +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 + \ No newline at end of file diff --git a/wizards/source/access2base/Utils.xba b/wizards/source/access2base/Utils.xba index ace29d9104ec..0f9580342edf 100644 --- a/wizards/source/access2base/Utils.xba +++ b/wizards/source/access2base/Utils.xba @@ -162,29 +162,6 @@ Public Function _DecimalPoint() As String _DecimalPoint = Mid(Format(0, "0.0"), 2, 1) 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 @@ -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 69e6e49903ad..5f533febc20b 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 78efee99e8c4..3bdae29e7e9b 100644 --- a/wizards/source/access2base/script.xlb +++ b/wizards/source/access2base/script.xlb @@ -26,4 +26,5 @@ - + + \ No newline at end of file -- cgit v1.2.3