wizards/source/access2base/Utils.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="Utils" 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 Explicit
   9
  10 Global _A2B_                    As Variant
  11
  12 REM -----------------------------------------------------------------------------------------------------------------------
  13 REM --- PRIVATE FUNCTIONS                                                                                                                                                                                       ---
  14 REM -----------------------------------------------------------------------------------------------------------------------
  15
  16 Public Function _AddNumeric(ByVal Optional pvTypes As Variant) As Variant
  17 &apos;Return on top of argument the list of all numeric types
  18 &apos;Facilitates the entry of the list of allowed types in _CheckArgument calls
  19
  20 Dim i As Integer, vNewList() As Variant, vNumeric() As Variant, iSize As Integer
  21         If IsMissing(pvTypes) Then
  22                 vNewList = Array()
  23         ElseIf IsArray(pvTypes) Then
  24                 vNewList = pvTypes
  25         Else
  26                 vNewList = Array(pvTypes)
  27         End If
  28
  29         vNumeric = Array(vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal)
  30
  31         iSize = UBound(vNewlist)
  32         ReDim Preserve vNewList(iSize + UBound(vNumeric) + 1)
  33         For i = 0 To UBound(vNumeric)
  34                 vNewList(iSize + i + 1) = vNumeric(i)
  35         Next i
  36
  37         _AddNumeric = vNewList
  38
  39 End Function            &apos;  _AddNumeric     V0.8.0
  40
  41 REM -----------------------------------------------------------------------------------------------------------------------
  42
  43 Public Function _BitShift(piValue As Integer, piConstant As Integer) As Boolean
  44
  45         _BitShift = False
  46         If piValue = 0 Then Exit Function
  47         Select Case piConstant
  48                 Case 1
  49                         Select Case piValue
  50                                 Case 1, 3, 5, 7, 9, 11, 13, 15:                         _BitShift = True
  51                                 Case Else
  52                         End Select
  53                 Case 2
  54                         Select Case piValue
  55                                 Case 2, 3, 6, 7, 10, 11, 14, 15:                        _BitShift = True
  56                                 Case Else
  57                         End Select
  58                 Case 4
  59                         Select Case piValue
  60                                 Case 4, 5, 6, 7, 12, 13, 14, 15:                        _BitShift = True
  61                                 Case Else
  62                         End Select
  63                 Case 8
  64                         Select Case piValue
  65                                 Case 8, 9, 10, 11, 12, 13, 14, 15:                      _BitShift = True
  66                                 Case Else
  67                         End Select
  68         End Select
  69
  70 End Function            &apos;  BitShift
  71
  72 REM -----------------------------------------------------------------------------------------------------------------------
  73 Public Function _CalledSub() As String
  74         _CalledSub = Iif(_A2B_.CalledSub = &quot;&quot;, &quot;&quot;, _GetLabel(&quot;CALLTO&quot;) &amp; &quot; &apos;&quot; &amp; _A2B_.CalledSub &amp; &quot;&apos;&quot;)
  75 End Function    &apos;  CalledSub       V0.8.9
  76
  77
  78 REM -----------------------------------------------------------------------------------------------------------------------
  79 Public Function _CheckArgument(pvItem As Variant _
  80                         , ByVal piArgNr As Integer _
  81                         , Byval pvType As Variant _
  82                         , ByVal Optional pvValid As Variant _
  83                         , ByVal Optional pvError As Boolean _
  84                         ) As Variant
  85 &apos;  Called by public functions to check the validity of their arguments
  86 &apos;          pvItem                          Argument to be checked
  87 &apos;          piArgNr                         Argument sequence number
  88 &apos;          pvType                          Single value or array of allowed variable types
  89 &apos;                                                  If of string type must contain one or more valid pseudo-object types
  90 &apos;          pvValid                         Single value or array of allowed values - comparison for strings is case-insensitive
  91 &apos;          pvError                         If True (default), error handling in this routine. False in _setProperty methods in class modules.
  92
  93         _CheckArgument = False
  94
  95 Dim iVarType As Integer
  96         If IsArray(pvType) Then iVarType = VarType(pvType(LBound(pvType))) Else iVarType = VarType(pvType)
  97         If iVarType = vbString Then                                     &apos;  pvType is a pseudo-type string
  98                 _CheckArgument = Utils._IsPseudo(pvItem, pvType)
  99         Else
 100                 If IsMissing(pvValid) Then _CheckArgument = Utils._IsScalar(pvItem, pvType) Else _CheckArgument = Utils._IsScalar(pvItem, pvType, pvValid)
 101         End If
 102
 103         If VarType(pvItem) = vbCurrency Or VarType(pvItem) = vbDecimal Or VarType(pvItem) = vbBigint Then pvItem = CDbl(pvItem)
 104
 105 Exit_Function:
 106 Const cstObject = &quot;[com.sun.star.script.NativeObjectWrapper]&quot;
 107         If Not _CheckArgument Then
 108                 If IsMissing(pvError) Then pvError = True
 109                 If pvError Then
 110                         TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(piArgNr, pvItem))
 111                 End If
 112         End If
 113         Exit Function
 114 End Function    &apos;  CheckArgument   V0.9.0
 115
 116 REM -----------------------------------------------------------------------------------------------------------------------
 117 Public Function _CStr(pvArg As Variant, ByVal Optional pbShort As Boolean) As String
 118 &apos;  Convert pvArg into a readable string (truncated if too long and pbShort = True or missing)
 119
 120 Dim sArg As String, sObject As String, oArg As Object, sLength As String
 121 Const cstLength = 50
 122         If IsArray(pvArg) Then
 123                 sArg = &quot;[ARRAY]&quot;
 124         Else
 125                 Select Case VarType(pvArg)
 126                         Case vbEmpty                    :               sArg = &quot;[EMPTY]&quot;
 127                         Case vbNull                             :               sArg = &quot;[NULL]&quot;
 128                         Case vbObject
 129                                 If IsNull(pvArg) Then
 130                                         sArg = &quot;[NULL]&quot;
 131                                 Else
 132                                         sObject = Utils._ImplementationName(pvArg)
 133                                         If Utils._IsPseudo(pvArg, Array(OBJDATABASE, OBJCOLLECTION, OBJPROPERTY, OBJFORM, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP _
 134                                                                 , OBJEVENT, OBJFIELD, OBJTABLEDEF, OBJQUERYDEF, OBJRECORDSET _
 135                                                                 )) Then
 136                                                 Set oArg = pvArg                &apos;  To avoid &quot;Object variable not set&quot; error message
 137                                                 sArg = &quot;[&quot; &amp; oArg._Type &amp; &quot;] &quot; &amp; oArg._Name
 138                                         ElseIf sObject &lt;&gt; &quot;&quot; Then
 139                                                 sArg = &quot;[&quot; &amp; sObject &amp; &quot;]&quot;
 140                                         Else
 141                                                 sArg = &quot;[OBJECT]&quot;
 142                                         End If
 143                                 End If
 144                         Case vbVariant                  :               sArg = &quot;[VARIANT]&quot;
 145                         Case vbString                   :               sArg = pvArg
 146                         Case vbBoolean                  :               sArg = Iif(pvArg, &quot;TRUE&quot;, &quot;FALSE&quot;)
 147                         Case Else                               :               sArg = CStr(pvArg)
 148                 End Select
 149         End If
 150         If IsMissing(pbShort) Then pbShort = True
 151         If pbShort And Len(sArg) &gt; cstLength Then
 152                 sLength = &quot;(&quot; &amp; Len(sArg) &amp; &quot;)&quot;
 153                 sArg = Left(sArg, cstLength - 5 - Len(slength)) &amp; &quot; ... &quot; &amp; sLength
 154         End If
 155         _CStr = sArg
 156
 157 End Function    &apos;  CStr                    V0.9.5
 158
 159 REM -----------------------------------------------------------------------------------------------------------------------
 160 Public Function _DecimalPoint() As String
 161 &apos;Return locale decimal point
 162         _DecimalPoint = Mid(Format(0, &quot;0.0&quot;), 2, 1)
 163 End Function
 164
 165 REM -----------------------------------------------------------------------------------------------------------------------
 166 Private Function _ExtensionLocation() As String
 167 &apos;  Return the URL pointing to the location where OO installed the Access2Base extension
 168 &apos;  Adapted from http://wiki.services.openoffice.org/wiki/Documentation/DevGuide/Extensions/Location_of_Installed_Extensions
 169
 170 Dim oPip As Object, sLocation As String
 171         Set oPip = GetDefaultContext.getByName(&quot;/singletons/com.sun.star.deployment.PackageInformationProvider&quot;)
 172         _ExtensionLocation = oPip.getPackageLocation(&quot;Access2Base&quot;)
 173
 174 End Function    &apos;  ExtensionLocation
 175
 176 REM -----------------------------------------------------------------------------------------------------------------------
 177 Private Function _getResultSetColumnValue(poResultSet As Object, Byval piColIndex As Integer) As Variant
 178 REM Modified from Roberto Benitez&apos;s BaseTools
 179 REM get the data for the column specified by ColIndex
 180 REM get type name from metadata
 181
 182 Dim vValue As Variant, sType As String, vDateTime As Variant
 183 Dim bNullable As Boolean, bNull As Boolean, oValue As Object
 184
 185         On Local Error Goto 0                   &apos;  Disable error handler
 186         vValue = Null                                   &apos;  Default value if error
 187         sType = poResultSet.MetaData.getColumnTypeName(piColIndex)
 188         With poResultSet
 189                 bNullable = ( .MetaData.IsNullable(piColIndex) = com.sun.star.sdbc.ColumnValue.NULLABLE )
 190                 Select Case sType
 191                         Case &quot;ARRAY&quot;:                                                 vValue = .getArray(piColIndex)
 192                         Case &quot;BINARY&quot;, &quot;VARBINARY&quot;, &quot;LONGVARBINARY&quot;
 193                                                                                                         Set oValue = .getBinaryStream(piColIndex)
 194                                                                                                         If bNullable Then bNull = .wasNull()
 195                                                                                                         If Not bNull Then vValue = CLng(oValue.getLength())             &apos;  Return length, not content
 196                                                                                                         oValue.closeInput()
 197                         Case &quot;BLOB&quot;:                                                  vValue = .getBlob(piColIndex)
 198                         Case &quot;BIT&quot;, &quot;BOOLEAN&quot;:                                      vValue = .getBoolean(piColIndex)
 199                         Case &quot;BYTE&quot;:                                                  vValue = .getByte(piColIndex)
 200                         Case &quot;BYTES&quot;:                                                 vValue = .getBytes(piColIndex)
 201                         Case &quot;CLOB&quot;:                                                  vValue = .getClob(piColIndex)
 202                         Case &quot;DATE&quot;:                                                  vDateTime = .getDate(piColIndex)
 203                                                                                                         If bNullable Then bNull = .wasNull()
 204                                                                                                         If Not bNull Then vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day))
 205                         Case &quot;DOUBLE&quot;, &quot;REAL&quot;:                                      vValue = .getDouble(piColIndex)
 206                         Case &quot;FLOAT&quot;:                                                 vValue = .getFloat(piColIndex)
 207                         Case &quot;INTEGER&quot;, &quot;SMALLINT&quot;:                         vValue = .getInt(piColIndex)
 208                         Case &quot;LONG&quot;, &quot;BIGINT&quot;:                                      vValue = .getLong(piColIndex)
 209                         Case &quot;DECIMAL&quot;, &quot;NUMERIC&quot;:                          vValue = .getDouble(piColIndex)
 210                         Case &quot;NULL&quot;:                                                  vValue = .getNull(piColIndex)
 211                         Case &quot;OBJECT&quot;:                                                        vValue = Null   &apos;  .getObject(piColIndex)  does not work that well in Basic ...
 212                         Case &quot;REF&quot;:                                                           vValue = .getRef(piColIndex)
 213                         Case &quot;SHORT&quot;, &quot;TINYINT&quot;:                            vValue = .getShort(piColIndex)
 214                         Case &quot;CHAR&quot;, &quot;VARCHAR&quot;, &quot;LONGVARCHAR&quot;:    vValue = .getString(piColIndex)
 215                         Case &quot;TIME&quot;:                                                  vDateTime = .getTime(piColIndex)
 216                                                                                                         If bNullable Then bNull = .wasNull()
 217                                                                                                         If Not bNull Then vValue = TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)&apos;, vDateTime.HundredthSeconds)
 218                         Case &quot;TIMESTAMP&quot;:                                             vDateTime = .getTimeStamp(piColIndex)
 219                                                                                                         If bNullable Then bNull = .wasNull()
 220                                                                                                         If Not bNull Then vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day)) _
 221                                                                                                                                 + TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)&apos;, vDateTime.HundredthSeconds)
 222                         Case Else
 223                                 vValue = .getString(piColIndex)                                         &apos;GIVE STRING A TRY
 224                                 If IsNumeric(vValue) Then vValue = Val(vValue)          &apos;Required when type = &quot;&quot;, sometimes numeric fields are returned as strings (query/MSAccess)
 225                 End Select
 226                 If bNullable Then bNull = .wasNull()
 227                 If bNull Then vValue = Null
 228         End With
 229
 230         _getResultSetColumnValue = vValue
 231
 232 End Function    &apos;  getResultSetColumnValue         V 1.1.0
 233
 234 REM -----------------------------------------------------------------------------------------------------------------------
 235 Public Function _FinalProperty(psShortcut As String) As String
 236 &apos; Return the final property of a shortcut
 237
 238 Const cstEXCLAMATION = &quot;!&quot;
 239 Const cstDOT = &quot;.&quot;
 240
 241 Dim iCurrentIndex As Integer, vCurrentObject As Variant, sCurrentProperty As String
 242 Dim sComponents() As String, sSubComponents() As String
 243         _FinalProperty = &quot;&quot;
 244         sComponents = Split(Trim(psShortcut), cstEXCLAMATION)
 245         If UBound(sComponents) = 0 Then Exit Function
 246         sSubComponents = Split(sComponents(UBound(sComponents)), cstDOT)
 247         Select Case UBound(sSubComponents)
 248                 Case 1
 249                         _FinalProperty = sSubComponents(1)
 250                 Case Else
 251                         Exit Function
 252         End Select
 253
 254 End Function    &apos;  FinalProperty
 255
 256 REM -----------------------------------------------------------------------------------------------------------------------
 257 Public Function _GetProductName(ByVal Optional psFlag As String) as String
 258 &apos;Return OO product (&quot;PRODUCT&quot;) and version numbers (&quot;VERSION&quot;)
 259 &apos;Derived from Tools library
 260
 261 Dim oProdNameAccess as Object
 262 Dim sVersion as String
 263 Dim sProdName as String
 264         If IsMissing(psFlag) Then psFlag = &quot;ALL&quot;
 265         oProdNameAccess = _GetRegistryKeyContent(&quot;org.openoffice.Setup/Product&quot;)
 266         sProdName = oProdNameAccess.getByName(&quot;ooName&quot;)
 267         sVersion = oProdNameAccess.getByName(&quot;ooSetupVersionAboutBox&quot;)
 268         Select Case psFlag
 269                 Case &quot;ALL&quot;                    :       _GetProductName = sProdName &amp; &quot; &quot; &amp; sVersion
 270                 Case &quot;PRODUCT&quot;                :       _GetProductName = sProdName
 271                 Case &quot;VERSION&quot;                :       _GetProductName = sVersion
 272         End Select
 273 End Function    &apos;  GetProductName          V1.0.0
 274
 275 REM -----------------------------------------------------------------------------------------------------------------------
 276 Public Function _GetRegistryKeyContent(sKeyName as string, Optional bforUpdate as Boolean) As Variant
 277 &apos;Implement ConfigurationProvider service
 278 &apos;Derived from Tools library
 279
 280 Dim oConfigProvider as Object
 281 Dim aNodePath(0) as new com.sun.star.beans.PropertyValue
 282         oConfigProvider = createUnoService(&quot;com.sun.star.configuration.ConfigurationProvider&quot;)
 283         aNodePath(0).Name = &quot;nodepath&quot;
 284         aNodePath(0).Value = sKeyName
 285         If IsMissing(bForUpdate) Then bForUpdate = False
 286         If bForUpdate Then
 287                 _GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments(&quot;com.sun.star.configuration.ConfigurationUpdateAccess&quot;, aNodePath())
 288         Else
 289                 _GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments(&quot;com.sun.star.configuration.ConfigurationAccess&quot;, aNodePath())
 290         End If
 291 End Function    &apos;  GetRegistryKeyContent   V0.8.5
 292
 293 REM -----------------------------------------------------------------------------------------------------------------------
 294 Public Function _getUNOTypeName(pvObject As Variant) As String
 295 &apos; Return the symbolic name of the pvObject (UNO-object) type
 296 &apos; Code-snippet from XRAY
 297
 298 Dim oService As Object, vClass as Variant
 299         _getUNOTypeName = &quot;&quot;
 300         On Local Error Resume Next
 301         oService = CreateUnoService(&quot;com.sun.star.reflection.CoreReflection&quot;)
 302         vClass = oService.getType(pvObject)
 303         If vClass.TypeClass = com.sun.star.uno.TypeClass.STRUCT  Then
 304                 _getUNOTypeName = vClass.Name
 305         End If
 306         oService.Dispose()
 307
 308 End Function    &apos;  getUNOTypeName
 309
 310 REM -----------------------------------------------------------------------------------------------------------------------
 311 Public Function _hasUNOMethod(pvObject As Variant, psMethod As String) As Boolean
 312 &apos; Return true if pvObject has the (UNO) method psMethod
 313 &apos; Code-snippet found in Bernard Marcelly&apos;s XRAY
 314
 315 Dim vInspect as Variant
 316         _hasUNOMethod = False
 317         On Local Error Resume Next
 318         vInspect = _A2B_.Introspection.Inspect(pvObject)
 319         _hasUNOMethod = vInspect.hasMethod(psMethod, com.sun.star.beans.MethodConcept.ALL)
 320
 321 End Function    &apos;  hasUNOMethod    V0.8.0
 322
 323 REM -----------------------------------------------------------------------------------------------------------------------
 324 Public Function _hasUNOProperty(pvObject As Variant, psProperty As String) As Boolean
 325 &apos; Return true if pvObject has the (UNO) property psProperty
 326 &apos; Code-snippet found in Bernard Marcelly&apos;s XRAY
 327
 328 Dim vInspect as Variant
 329         _hasUNOProperty = False
 330         On Local Error Resume Next
 331         vInspect = _A2B_.Introspection.Inspect(pvObject)
 332         _hasUNOProperty = vInspect.hasProperty(psProperty, com.sun.star.beans.PropertyConcept.ALL)
 333
 334 End Function    &apos;  hasUNOProperty  V0.8.0
 335
 336 REM -----------------------------------------------------------------------------------------------------------------------
 337 Public Function _ImplementationName(pvObject As Variant) As String
 338 &apos;  Use getImplementationName method or _getUNOTypeName function
 339
 340 Dim sObjectType As String
 341         On Local Error Resume Next
 342         sObjectType = pvObject.getImplementationName()
 343         If sObjectType = &quot;&quot; Then sObjectType =  _getUNOTypeName(pvObject)
 344
 345         _ImplementationName = sObjectType
 346
 347 End Function            &apos;  ImplementationName
 348
 349 REM -----------------------------------------------------------------------------------------------------------------------
 350 Public Function _InList(ByVal pvItem As Variant, pvList As Variant, ByVal Optional pvReturnValue As Variant, Optional ByVal pbBinarySearch As Boolean) As Variant
 351 &apos;  Return True if pvItem is present in the pvList array (case insensitive comparison)
 352 &apos;  Return the value in pvList if pvReturnValue = True
 353
 354 Dim i As Integer, bFound As Boolean, iListVarType As Integer, iItemVarType As Integer
 355 Dim iTop As Integer, iBottom As Integer, iFound As Integer
 356         iItemVarType = VarType(pvItem)
 357         If IsMissing(pvReturnValue) Then pvReturnValue = False
 358         If iItemVarType = vbNull Or IsNull(pvList) Then
 359                 _InList = False
 360         ElseIf Not IsArray(pvList) Then
 361                 If iItemVarType = vbString Then bFound = ( UCase(pvItem) = UCase(pvList) ) Else bFound = ( pvItem = pvList )
 362                 If Not pvReturnValue Then
 363                         _InList = bFound
 364                 Else
 365                         If bFound Then _InList = pvList Else _InList = False
 366                 End If
 367         ElseIf UBound(pvList) &lt; LBound(pvList) Then          &apos;  Array not initialized
 368                 _InList = False
 369         Else
 370                 bFound = False
 371                 _InList = False
 372                 iListVarType = VarType(pvList(LBound(pvList)))
 373                 If iListVarType = iItemVarType _
 374                         Or ( (iListVarType = vbInteger Or iListVarType = vbLong Or iListVarType = vbSingle Or iListVarType = vbDouble _
 375                                         Or iListVarType = vbCurrency Or iListVarType = vbBigint Or iListVarType = vbDecimal) _
 376                                 And (iItemVarType = vbInteger Or iItemVarType = vbLong Or iItemVarType = vbSingle Or iItemVarType = vbDouble _
 377                                         Or iItemVarType = vbCurrency Or iItemVarType = vbBigint Or iItemVarType = vbDecimal) _
 378                                 ) Then
 379                         If IsMissing(pbBinarySearch) Then pbBinarySearch = False
 380                         If Not pbBinarySearch Then                      &apos;  Linear search
 381                                 For i = LBound(pvList) To UBound(pvList)
 382                                         If iItemVarType = vbString Then bFound = ( UCase(pvItem) = UCase(pvList(i)) ) Else bFound = ( pvItem = pvList(i) )
 383                                         If bFound Then
 384                                                 iFound = i
 385                                                 Exit For
 386                                         End If
 387                                 Next i
 388                         Else                                                            &apos;  Binary search =&gt; array must be sorted
 389                                 iTop = UBound(pvList)
 390                                 iBottom = lBound(pvList)
 391                                 Do
 392                                         iFound = (iTop + iBottom) / 2
 393                                         If ( iItemVarType = vbString And UCase(pvItem) &gt; UCase(pvList(iFound)) ) Or ( iItemVarType &lt;&gt; vbString And pvItem &gt; pvList(iFound) ) Then
 394                                                 iBottom = iFound + 1
 395                                         Else
 396                                                 iTop = iFound - 1
 397                                         End If
 398                                         If iItemVarType = vbString Then bFound = ( UCase(pvItem) = UCase(pvList(iFound)) ) Else bFound = ( pvItem = pvList(iFound) )
 399                                 Loop Until ( bFound ) Or ( iBottom &gt; iTop )
 400                         End If
 401                         If bFound Then
 402                                 If Not pvReturnValue Then _InList = True Else _InList = pvList(iFound)
 403                         End If
 404                 End If
 405         End If
 406
 407         Exit Function
 408
 409 End Function    &apos;  InList V1.1.0
 410
 411 REM -----------------------------------------------------------------------------------------------------------------------
 412 Public Function _InspectPropertyType(poObject As Object, psProperty As String) As String
 413 &apos;Return type of property EVEN WHEN EMPTY ! (Used in date and time controls)
 414
 415 Dim oInspect1 As Object, oInspect2 As Object, oInspect3 As Object
 416 &apos;  On Local Error Resume Next
 417         _InspectPropertyType = &quot;&quot;
 418         Set oInspect1 = CreateUnoService(&quot;com.sun.star.script.Invocation&quot;)
 419         Set oInspect2 = oInspect1.createInstanceWithArguments(Array(poObject)).IntroSpection
 420         If Not IsNull(oInspect2) Then
 421                 Set oInspect3 = oInspect2.getProperty(psProperty, com.sun.star.beans.PropertyConcept.ALL)
 422                 If Not IsNull(oInspect3) Then _InspectPropertyType = oInspect3.Type.Name
 423         End If
 424         Set oInspect1 = Nothing :       Set oInspect2 = Nothing :       Set oInspect3 = Nothing
 425
 426 End Function    &apos;  InspectPropertyType     V1.0.0
 427
 428 REM -----------------------------------------------------------------------------------------------------------------------
 429 Public Function _IsLeft(psString As String, psLeft As String) As Boolean
 430 &apos;  Return True if left part of psString = psLeft
 431
 432 Dim iLength As Integer
 433         iLength = Len(psLeft)
 434         _IsLeft = False
 435         If Len(psString) &gt;= iLength Then
 436                 If Left(psString, iLength) = psLeft Then _IsLeft = True
 437         End If
 438
 439 End Function
 440
 441 REM -----------------------------------------------------------------------------------------------------------------------
 442 Public Function _IsPseudo(pvObject As Variant, ByVal pvType As Variant) As Boolean
 443 &apos;  Test pvObject:  does it exist ?
 444 &apos;                                  is the _Type item = one of the proposed pvTypes ?
 445 &apos;                                  does the pseudo-object refer to an existing object (e.g. does the form really exist in the db) ?
 446
 447 Dim bIsPseudo As Boolean, bPseudoExists As Boolean, vObject As Variant
 448
 449         If _ErrorHandler() Then On Local Error Goto Exit_False
 450
 451         _IsPseudo = False
 452         bIsPseudo = False
 453         vObject = pvObject                                      &apos;  To avoid &quot;Object variable not set&quot; error message
 454         Select Case True
 455                 Case IsEmpty(vObject)
 456                 Case IsNull(vObject)
 457                 Case VarType(vObject) &lt;&gt; vbObject
 458                 Case Else
 459                         With vObject
 460                                 Select Case True
 461                                         Case IsEmpty(._Type)
 462                                         Case IsNull(._Type)
 463                                         Case ._Type = &quot;&quot;
 464                                         Case Else
 465                                                 bIsPseudo = _InList(._Type, pvType)
 466                                                 If Not bIsPseudo Then           &apos;  If primary type did not succeed, give the subtype a chance
 467                                                         If ._Type = OBJCONTROL Then bIsPseudo = _InList(._SubType, pvType)
 468                                                 End If
 469                                 End Select
 470                         End With
 471         End Select
 472
 473         If Not bIsPseudo Then Goto Exit_Function
 474
 475 Dim oDoc As Object, oForms As Variant
 476
 477         bPseudoExists = False
 478         With vObject
 479                 Select Case ._Type
 480                         Case OBJFORM
 481                                 If ._Name &lt;&gt; &quot;&quot; Then            &apos;  Check validity of form name
 482                                         Set oDoc = _A2B_.CurrentDocument()
 483                                         If oDoc.DbConnect = DBCONNECTFORM Then
 484                                                 bPseudoExists = True
 485                                         Else
 486                                                 Set oForms = oDoc.Document.getFormDocuments()
 487                                                 bPseudoExists = ( oForms.HasByName(._Name) )
 488                                         End If
 489                                 End If
 490                         Case OBJDATABASE
 491                                 If ._DbConnect = DBCONNECTFORM Then bPseudoExists = True Else bPseudoExists = .Document.CurrentController.IsConnected
 492                         Case OBJDIALOG
 493                                 If ._Name &lt;&gt; &quot;&quot; Then            &apos;  Check validity of dialog name
 494                                         bPseudoExists = ( _A2B_.hasItem(COLLALLDIALOGS, ._Name) )
 495                                 End If
 496                         Case OBJCOLLECTION
 497                                 bPseudoExists = True
 498                         Case OBJCONTROL
 499                                 If Not IsNull(.ControlModel) And ._Name &lt;&gt; &quot;&quot; Then              &apos;  Check validity of control
 500                                         Set oForms = .ControlModel.Parent
 501                                         bPseudoExists = ( oForms.hasByName(._Name) )
 502                                 End If
 503                         Case OBJSUBFORM
 504                                 If Not IsNull(.DatabaseForm) And ._Name &lt;&gt; &quot;&quot; Then              &apos;  Check validity of subform
 505                                         If .DatabaseForm.ImplementationName = &quot;com.sun.star.comp.forms.ODatabaseForm&quot; Then
 506                                                 Set oForms = .DatabaseForm.Parent
 507                                                 bPseudoExists = ( oForms.hasByName(._Name) )
 508                                         End If
 509                                 End If
 510                         Case OBJOPTIONGROUP
 511                                 bPseudoExists = ( .Count &gt; 0 )
 512                         Case OBJCOMMANDBAR
 513                                 bPseudoExists = ( Not IsNull(._Window) )
 514                         Case OBJCOMMANDBARCONTROL
 515                                 bPseudoExists = ( Not IsNull(._ParentCommandBar) )
 516                         Case OBJEVENT
 517                                 bPseudoExists = ( Not IsNull(._EventSource) )
 518                         Case OBJPROPERTY
 519                                 bPseudoExists = ( ._Name &lt;&gt; &quot;&quot; )
 520                         Case OBJTABLEDEF
 521                                 bPseudoExists = ( ._Name &lt;&gt; &quot;&quot; And Not IsNull(.Table) )
 522                         Case OBJQUERYDEF
 523                                 bPseudoExists = ( ._Name &lt;&gt; &quot;&quot; And Not IsNull(.Query) )
 524                         Case OBJRECORDSET
 525                                 bPseudoExists = ( Not IsNull(.RowSet) )
 526                         Case OBJFIELD
 527                                 bPseudoExists = ( ._Name &lt;&gt; &quot;&quot; And Not IsNull(.Column) )
 528                         Case OBJTEMPVAR
 529                                 If ._Name &lt;&gt; &quot;&quot; Then            &apos;  Check validity of tempvar name
 530                                         bPseudoExists = ( _A2B_.hasItem(COLLTEMPVARS, ._Name) )
 531                                 End If
 532                         Case Else
 533                 End Select
 534         End With
 535
 536         _IsPseudo = ( bIsPseudo And bPseudoExists )
 537
 538 Exit_Function:
 539         Exit Function
 540 Exit_False:
 541         _IsPseudo = False
 542         Goto Exit_Function
 543 End Function    &apos;  IsPseudo                V1.1.0
 544
 545 REM -----------------------------------------------------------------------------------------------------------------------
 546 Private Function _IsScalar(ByVal pvArg As Variant, Byval pvType As Variant, ByVal Optional pvValid As Variant) As Boolean
 547 &apos;  Check type of pvArg and value in allowed pvValid list
 548
 549         _IsScalar = False
 550
 551         If IsArray(pvType) Then
 552                 If Not _InList(VarType(pvArg), pvType) Then Exit Function
 553         ElseIf VarType(pvArg) &lt;&gt; pvType Then
 554                 If pvType = vbBoolean And VarType(pvArg) = vbLong Then
 555                         If pvArg &lt; -1 And pvArg &gt; 0 Then Exit Function    &apos;  Special boolean processing because the Not function returns a Long
 556                 Else
 557                         Exit Function
 558                 End If
 559         End If
 560         If Not IsMissing(pvValid) Then
 561                 If Not _InList(pvArg, pvValid) Then Exit Function
 562         End If
 563
 564         _IsScalar = True
 565
 566 Exit_Function:
 567         Exit Function
 568 End Function    &apos;  IsScalar        V0.7.5
 569
 570 REM -----------------------------------------------------------------------------------------------------------------------
 571 Public Function _PCase(ByVal psString As String) As String
 572 &apos;  Return the proper case representation of argument
 573
 574 Dim vSubStrings() As Variant, i As Integer, iLen As Integer
 575         vSubStrings = Split(psString, &quot; &quot;)
 576         For i = 0 To UBound(vSubStrings)
 577                 iLen = Len(vSubStrings(i))
 578                 If iLen &gt; 1 Then
 579                         vSubStrings(i) = UCase(Left(vSubStrings(i), 1)) &amp; LCase(Right(vSubStrings(i), iLen - 1))
 580                 ElseIf iLen = 1 Then
 581                         vSubStrings(i) = UCase(vSubStrings(i))
 582                 End If
 583         Next i
 584         _PCase = Join(vSubStrings, &quot; &quot;)
 585
 586 End Function    &apos;  PCase           V0.9.0
 587
 588 REM -----------------------------------------------------------------------------------------------------------------------
 589 Public Sub _ResetCalledSub(ByVal psSub As String)
 590 &apos;  Called in bottom of each public function. _A2B_.CalledSub variable is used for error handling
 591 &apos;  Used to trace routine in/outs and to clarify error messages
 592                 If IsEmpty(_A2B_) Then Call Application._RootInit()     &apos;  Only is Utils module recompiled
 593                 If _A2B_.CalledSub = psSub Then _A2B_.CalledSub = &quot;&quot;
 594                 If _A2B_.MinimalTraceLevel = 1 Then TraceLog(TRACEDEBUG, _GetLabel(&quot;Exiting&quot;) &amp; &quot; &quot; &amp; psSub &amp; &quot; ...&quot;, False)
 595 End Sub                 &apos;  ResetCalledSub
 596
 597 REM -----------------------------------------------------------------------------------------------------------------------
 598 Public Function _RunScript(ByVal psScript As String, Optional pvArgs() As Variant) As Boolean
 599 &apos;  Execute a given script with pvArgs() array of arguments
 600
 601         On Local Error Goto Error_Function
 602         _RunScript = False
 603         If IsNull(ThisComponent) Then Goto Exit_Function
 604
 605 Dim oSCriptProvider As Object, oScript As Object, vResult As Variant
 606
 607         Set oScriptProvider = ThisComponent.ScriptProvider()
 608         Set oScript = oScriptProvider.getScript(psScript)
 609         If IsMissing(pvArgs()) Then pvArgs() = Array()
 610         vResult = oScript.Invoke(pvArgs(), Array(), Array())
 611         _RunScript = True
 612
 613 Exit_Function:
 614         Exit Function
 615 Error_Function:
 616         _RunScript = False
 617         Goto Exit_Function
 618 End Function
 619
 620 REM -----------------------------------------------------------------------------------------------------------------------
 621 Public Sub _SetCalledSub(ByVal psSub As String)
 622 &apos;  Called in top of each public function.
 623 &apos;  Used to trace routine in/outs and to clarify error messages
 624                 If IsEmpty(_A2B_) Then Call Application._RootInit()     &apos;  First use of Access2Base in current LibO/AOO session
 625                 If _A2B_.CalledSub = &quot;&quot; Then _A2B_.CalledSub = psSub
 626                 If _A2B_.MinimalTraceLevel = 1 Then TraceLog(TRACEDEBUG, _GetLabel(&quot;Entering&quot;) &amp; &quot; &quot; &amp; psSub &amp; &quot; ...&quot;, False)
 627 End Sub                 &apos;  SetCalledSub
 628
 629 REM -----------------------------------------------------------------------------------------------------------------------
 630 Public Function _Surround(ByVal psName As String) As String
 631 &apos; Return [Name] if Name contains spaces
 632 Const cstSquareOpen = &quot;[&quot;
 633 Const cstSquareClose = &quot;]&quot;
 634         If InStr(psName, &quot; &quot;) &gt; 0 Then
 635                 _Surround = cstSquareOpen &amp; psName &amp; cstSquareClose
 636         Else
 637                 _Surround = psName
 638         End If
 639 End Function    &apos;  Surround
 640
 641 REM -----------------------------------------------------------------------------------------------------------------------
 642 Public Function _Trim(ByVal psString As String) As String
 643 &apos;  Remove leading and trailing spaces, remove surrounding square brackets
 644 Const cstSquareOpen = &quot;[&quot;
 645 Const cstSquareClose = &quot;]&quot;
 646 Dim sTrim As String
 647
 648         sTrim = Trim(psString)
 649         _Trim = sTrim
 650         If Len(sTrim) &lt;= 2 Then Exit Function
 651
 652         If Left(sTrim, 1) = cstSquareOpen Then
 653                 If Right(sTrim, 1) = cstSquareClose Then
 654                         _Trim = Mid(sTrim, 2, Len(sTrim) - 2)
 655                 End If
 656         End If
 657 End Function    &apos;  Trim    V0.9.0
 658
 659 REM -----------------------------------------------------------------------------------------------------------------------
 660 Public Function _TrimArray(pvArray As Variant) As Variant
 661 &apos;  Remove empty strings from strings array
 662
 663 Dim sTrim As String, vTrim() As Variant, i As Integer, j As Integer, iCount As Integer
 664         vTrim = Null
 665         If Not IsArray(pvArray) Then
 666                 If Len(Trim(pvArray)) &gt; 0 Then vTrim = Array(pvArray) Else vTrim = Array()
 667         ElseIf UBound(pvArray) &lt; LBound(pvArray) Then                                &apos;  Array empty
 668                 vTrim = Array()
 669         Else
 670                 iCount = 0
 671                 For i = LBound(pvArray) To UBound(pvArray)
 672                         If Len(Trim(pvArray(i))) = 0 Then iCount = iCount + 1
 673                 Next i
 674                 If iCount = 0 Then
 675                         vTrim() = pvArray()
 676                 ElseIf iCount = UBound(pvArray) - LBound(pvArray) + 1 Then      &apos;  Array empty or all blanks
 677                         vTrim() = Array()
 678                 Else
 679                         ReDim vTrim(LBound(pvArray) To UBound(pvArray) - iCount)
 680                         j = 0
 681                         For i = LBound(pvArray) To UBound(pvArray)
 682                                 If Len(Trim(pvArray(i))) &gt; 0 Then
 683                                         vTrim(j) = pvArray(i)
 684                                         j = j + 1
 685                                 End If
 686                         Next i
 687                 End If
 688         End If
 689
 690         _TrimArray() = vTrim()
 691
 692 End Function    &apos;  TrimArray       V0.9.0
 693 </script:module>