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