wizards/source/access2base/Root_.xba

   1 <?xml version="1.0" encoding="UTF-8"?>
   2 <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
   3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="Root_" script:language="StarBasic">REM =======================================================================================================================
   4 REM ===                                 The Access2Base library is a part of the LibreOffice project.                                                                   ===
   5 REM ===                                 Full documentation is available on http://www.access2base.com                                                                   ===
   6 REM =======================================================================================================================
   7
   8 Option Compatible
   9 Option ClassModule
  10
  11 Option Explicit
  12
  13 REM -----------------------------------------------------------------------------------------------------------------------
  14 REM --- FOR INTERNAL USE ONLY                                                                                                                                                                                   ---
  15 REM -----------------------------------------------------------------------------------------------------------------------
  16
  17 REM -----------------------------------------------------------------------------------------------------------------------
  18 REM --- CLASS ROOT FIELDS                                                                                                                                                                                       ---
  19 REM -----------------------------------------------------------------------------------------------------------------------
  20
  21 Private ErrorHandler            As Boolean
  22 Private MinimalTraceLevel       As Integer
  23 Private TraceLogs()                     As Variant
  24 Private TraceLogCount           As Integer
  25 Private TraceLogLast            As Integer
  26 Private TraceLogMaxEntries      As Integer
  27 Private CalledSub                       As String
  28 Private Introspection           As Object                               &apos;  com.sun.star.beans.Introspection
  29 Private VersionNumber           As String                               &apos;  Actual Access2Base version number
  30 Private FindRecord                      As Object
  31 Private StatusBar                       As Object
  32 Private Dialogs                         As Object                               &apos;  Collection
  33 Private TempVars                        As Object                               &apos;  Collection
  34 Private CurrentDoc()            As Variant                              &apos;  Array of document containers - [0] = Base document, [1 ... N] = other documents
  35
  36 Type DocContainer
  37         Document                        As Object                               &apos;  com.sun.star.comp.dba.ODatabaseDocument or SwXTextDocument or ScModelObj
  38         Active                          As Boolean
  39         DbConnect                       As Integer                              &apos;  DBCONNECTxxx constants
  40         URL                                     As String
  41         DbContainers()          As Variant                              &apos;  One entry by (data-aware) form
  42 End Type
  43
  44 Type DbContainer
  45         FormName                        As String                               &apos;  name of data-aware form
  46         Database                        As Object                               &apos;  Database type
  47 End Type
  48
  49 REM -----------------------------------------------------------------------------------------------------------------------
  50 REM --- CONSTRUCTORS / DESTRUCTORS                                                                                                                                                                      ---
  51 REM -----------------------------------------------------------------------------------------------------------------------
  52 Private Sub Class_Initialize()
  53 Dim vCurrentDoc() As Variant
  54         VersionNumber = Access2Base_Version
  55         ErrorHandler = True
  56         MinimalTraceLevel = 0
  57         TraceLogs() = Array()
  58         TraceLogCount = 0
  59         TraceLogLast = 0
  60         TraceLogMaxEntries = 0
  61         CalledSub = &quot;&quot;
  62         Set Introspection = CreateUnoService(&quot;com.sun.star.beans.Introspection&quot;)
  63         Set FindRecord = Nothing
  64         Set StatusBar = Nothing
  65         Set Dialogs = New Collection
  66         Set TempVars = New Collection
  67         vCurrentDoc() = Array()
  68         ReDim vCurrentDoc(0 To 0)
  69         Set vCurrentDoc(0) = Nothing
  70         Set CurrentDoc() = vCurrentDoc()
  71 End Sub         &apos;  Constructor
  72
  73 REM -----------------------------------------------------------------------------------------------------------------------
  74 Private Sub Class_Terminate()
  75         Call Class_Initialize()
  76 End Sub         &apos;  Destructor
  77
  78 REM -----------------------------------------------------------------------------------------------------------------------
  79 Public Sub Dispose()
  80         Call Class_Terminate()
  81 End Sub         &apos;  Explicit destructor
  82
  83 REM -----------------------------------------------------------------------------------------------------------------------
  84 REM --- CLASS GET/LET/SET PROPERTIES                                                                                                                                                            ---
  85 REM -----------------------------------------------------------------------------------------------------------------------
  86
  87 REM -----------------------------------------------------------------------------------------------------------------------
  88 REM --- CLASS METHODS                                                                                                                                                                                           ---
  89 REM -----------------------------------------------------------------------------------------------------------------------
  90
  91 REM -----------------------------------------------------------------------------------------------------------------------
  92 Public Sub CloseConnection()
  93 &apos;  Close all connections established by current document to free memory.
  94 &apos;  - if Base document =&gt; close the one concerned database connection
  95 &apos;  - if non-Base documents =&gt; close the connections of each individual standalone form
  96
  97 Dim i As Integer, iCurrentDoc As Integer
  98 Dim vDbContainer As Variant, vDbContainers() As Variant, vDocContainer As Variant
  99
 100         If ErrorHandler Then On Local Error Goto Error_Sub
 101
 102         If Not IsArray(CurrentDoc) Then Goto Exit_Sub
 103         If UBound(CurrentDoc) &lt; 0 Then Goto Exit_Sub
 104         iCurrentDoc = CurrentDocIndex( , False)                 &apos;  False prevents error raising if not found
 105         If iCurrentDoc &lt; 0 Then GoTo Exit_Sub                        &apos;  If not found ignore
 106
 107         vDocContainer = CurrentDocument(iCurrentDoc)
 108         With vDocContainer
 109                 If Not .Active Then GoTo Exit_Sub               &apos;  e.g. if successive calls to CloseConnection()
 110                 For i = 0 To UBound(.DbContainers)
 111                         If Not IsNull(.DbContainers(i).Database) Then
 112                                 .DbContainers(i).Database.Dispose()
 113                                 Set .DbContainers(i).Database = Nothing
 114                         End If
 115                         TraceLog(TRACEANY, UCase(CalledSub) &amp; &quot; &quot; &amp; .URL &amp; Iif(i = 0, &quot;&quot;, &quot; Form=&quot; &amp; .DbContainers(i).FormName), False)
 116                         Set .DbContainers(i) = Nothing
 117                 Next i
 118                 .DbContainers = Array()
 119                 .URL = &quot;&quot;
 120                 .DbConnect = 0
 121                 .Active = False
 122                 Set .Document = Nothing
 123         End With
 124         CurrentDoc(iCurrentDoc) = vDocContainer
 125
 126 Exit_Sub:
 127         Exit Sub
 128 Error_Sub:
 129         TraceError(TRACEABORT, Err, CalledSub, Erl, False)              &apos;  No error message addressed to the user, only stored in console
 130         GoTo Exit_Sub
 131 End Sub                 &apos;  CloseConnection
 132
 133 REM -----------------------------------------------------------------------------------------------------------------------
 134 Public Function CurrentDb() As Object
 135 &apos;  Returns _A2B_.CurrentDocument().Database as an object to allow access to its properties
 136
 137 Dim iCurrentDoc As Integer
 138
 139         Set CurrentDb = Nothing
 140
 141         If Not IsArray(CurrentDoc) Then Goto Exit_Function
 142         If UBound(CurrentDoc) &lt; 0 Then Goto Exit_Function
 143         iCurrentDoc = CurrentDocIndex(, False)          &apos;  False = no abort
 144         If iCurrentDoc &gt;= 0 Then
 145                 If UBound(CurrentDoc(iCurrentDoc).DbContainers) &gt;= 0 Then Set CurrentDb = CurrentDoc(iCurrentDoc).DbContainers(0).Database
 146         End If
 147
 148 Exit_Function:
 149         Exit Function
 150 End Function    &apos;  CurrentDb
 151
 152 REM -----------------------------------------------------------------------------------------------------------------------
 153 Public Function CurrentDocIndex(Optional pvURL As Variant, Optional pbAbort As Variant) As Integer
 154 &apos;  Returns the entry in CurrentDoc(...) referring to the current document
 155
 156 Dim i As Integer, bFound As Boolean, sURL As String
 157 Const cstBase = &quot;com.sun.star.comp.dba.ODatabaseDocument&quot;
 158
 159         bFound = False
 160         CurrentDocIndex = -1
 161
 162         If Not IsArray(CurrentDoc) Then Goto Trace_Error
 163         If UBound(CurrentDoc) &lt; 0 Then Goto Trace_Error
 164         For i = 1 To UBound(CurrentDoc)                                 &apos;  [0] reserved to database .odb document
 165                 If IsMissing(pvURL) Then                                                &apos;  Not on 1 single line ?!?
 166                         If Utils._hasUNOProperty(ThisComponent, &quot;URL&quot;) Then
 167                                 sURL = ThisComponent.URL
 168                         Else
 169                                 Exit For        &apos;  f.i. ThisComponent = Basic IDE ...
 170                         End If
 171                 Else
 172                         sURL = pvURL    &apos;  To support the SelectObject action
 173                 End If
 174                 If CurrentDoc(i).Active And CurrentDoc(i).URL = sURL Then
 175                         CurrentDocIndex = i
 176                         bFound = True
 177                         Exit For
 178                 End If
 179         Next  i
 180
 181         If Not bFound Then
 182                 If IsNull(CurrentDoc(0)) Then GoTo Trace_Error
 183                 With CurrentDoc(0)
 184                         If Not .Active Then GoTo Trace_Error
 185                         If IsNull(.Document) Then GoTo Trace_Error
 186                 End With
 187                 CurrentDocIndex = 0
 188         End If
 189
 190 Exit_Function:
 191         Exit Function
 192 Trace_Error:
 193         If IsMissing(pbAbort) Then pbAbort = True
 194         If pbAbort Then TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0, 1) Else CurrentDocIndex = -1
 195         Goto Exit_Function
 196 End Function    &apos;  CurrentDocIndex
 197
 198 REM -----------------------------------------------------------------------------------------------------------------------
 199 Public Function CurrentDocument(ByVal Optional piDocIndex As Integer) As Variant
 200 &apos;  Returns the CurrentDoc(...) referring to the current document or to the argument
 201
 202 Dim iDocIndex As Integer
 203         If IsMissing(piDocIndex) Then iDocIndex = CurrentDocIndex() Else iDocIndex = piDocIndex
 204         If iDocIndex &gt;= 0 And iDocIndex &lt;= UBound(CurrentDoc) Then Set CurrentDocument = CurrentDoc(iDocIndex) Else Set CurrentDocument = Nothing
 205
 206 End Function
 207
 208 REM -----------------------------------------------------------------------------------------------------------------------
 209 Public Sub Dump()
 210 &apos;  For debugging purposes
 211 Dim i As Integer, j As Integer, vCurrentDoc As Variant
 212         On Local Error Resume Next
 213
 214         DebugPrint &quot;Version&quot;, VersionNumber
 215         DebugPrint &quot;TraceLevel&quot;, MinimalTraceLevel
 216         DebugPrint &quot;TraceCount&quot;, TraceLogCount
 217         DebugPrint &quot;CalledSub&quot;, CalledSub
 218         If IsArray(CurrentDoc) Then
 219                 For i = 0 To UBound(CurrentDoc)
 220                         vCurrentDoc = CurrentDoc(i)
 221                         If Not IsNull(vCurrentDoc) Then
 222                                 DebugPrint i, &quot;URL&quot;, vCurrentDoc.URL
 223                                 For j = 0 To UBound(vCurrentDoc.DbContainers)
 224                                         DebugPrint i, j, &quot;Form&quot;, vCurrentDoc.DbContainers(j).FormName
 225                                         DebugPrint i, j, &quot;Database&quot;, vCurrentDoc.DbContainers(j).Database.Title
 226                                 Next j
 227                         End If
 228                 Next i
 229         End If
 230
 231 End Sub
 232
 233 REM -----------------------------------------------------------------------------------------------------------------------
 234 Public Function hasItem(psCollType As String, ByVal psName As String) As Boolean
 235 &apos;  Return True if psName if in the collection
 236
 237 Dim oItem As Object
 238         On Local Error Goto Error_Function              &apos;  Whatever ErrorHandler !
 239
 240         hasItem = True
 241         Select Case psCollType
 242                 Case COLLALLDIALOGS
 243                         Set oItem = Dialogs.Item(UCase(psName))
 244                 Case COLLTEMPVARS
 245                         Set oItem = TempVars.Item(UCase(psName))
 246                 Case Else
 247                         hasItem = False
 248         End Select
 249
 250 Exit_Function:
 251         Exit Function
 252 Error_Function:         &apos;  Item by key aborted
 253         hasItem = False
 254         GoTo Exit_Function
 255 End Function    &apos;  hasItem
 256
 257 REM -----------------------------------------------------------------------------------------------------------------------
 258 REM --- PRIVATE FUNCTIONS                                                                                                                                                                                       ---
 259 REM -----------------------------------------------------------------------------------------------------------------------
 260
 261 REM -----------------------------------------------------------------------------------------------------------------------
 262 Public Function _CurrentDb(ByVal Optional piDocEntry As Integer, ByVal Optional piDbEntry As Integer) As Variant
 263 REM Without arguments same as CurrentDb() except that it generates an error if database not connected (internal use)
 264 REM With 2 arguments return the corresponding entry in Root
 265
 266 Dim odbDatabase As Variant
 267         If IsMissing(piDocEntry) Then
 268                 Set odbDatabase = CurrentDb()
 269         Else
 270                 If Not IsArray(CurrentDoc) Then Goto Trace_Error
 271                 If piDocEntry &lt; 0 Or piDbEntry &lt; 0 Then Goto Trace_Error
 272                 If piDocEntry &gt; UBound(CurrentDoc) Then Goto Trace_Error
 273                 If piDbEntry &gt; UBound(CurrentDoc(piDocEntry).DbContainers) Then Goto Trace_Error
 274                 Set odbDatabase = CurrentDoc(piDocEntry).DbContainers(piDbEntry).Database
 275         End If
 276         If IsNull(odbDatabase) Then GoTo Trace_Error
 277
 278 Exit_Function:
 279         Set _CurrentDb = odbDatabase
 280         Exit Function
 281 Trace_Error:
 282         TraceError(TRACEABORT, ERRDBNOTCONNECTED, Utils._CalledSub(), 0, 1)
 283         Goto Exit_Function
 284 End Function            &apos;  _CurrentDb
 285 </script:module>