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