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">
   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 Explicit
  10
  11 Global _A2B_                    As Variant
  12
  13 REM -----------------------------------------------------------------------------------------------------------------------
  14 REM --- PRIVATE FUNCTIONS                                                                                                                                                                                       ---
  15 REM -----------------------------------------------------------------------------------------------------------------------
  16
  17 Public Function _AddArray(ByVal pvArray As Variant, pvItem As Variant) As Variant
  18 &apos;Add the item at the end of the array
  19
  20 Dim vArray() As Variant
  21         If IsArray(pvArray) Then vArray = pvArray Else vArray = Array()
  22         ReDim Preserve vArray(LBound(vArray) To UBound(vArray) + 1)
  23         vArray(UBound(vArray)) = pvItem
  24         _AddArray() = vArray()
  25
  26 End Function
  27
  28 REM -----------------------------------------------------------------------------------------------------------------------
  29 Public Function _AddNumeric(ByVal Optional pvTypes As Variant) As Variant
  30 &apos;Return on top of argument the list of all numeric types
  31 &apos;Facilitates the entry of the list of allowed types in _CheckArgument calls
  32
  33 Dim i As Integer, vNewList() As Variant, vNumeric() As Variant, iSize As Integer
  34         If IsMissing(pvTypes) Then
  35                 vNewList = Array()
  36         ElseIf IsArray(pvTypes) Then
  37                 vNewList = pvTypes
  38         Else
  39                 vNewList = Array(pvTypes)
  40         End If
  41
  42         vNumeric = Array(vbInteger, vbLong, vbSingle, vbDouble, vbCurrency, vbBigint, vbDecimal, vbBoolean)
  43
  44         iSize = UBound(vNewlist)
  45         ReDim Preserve vNewList(iSize + UBound(vNumeric) + 1)
  46         For i = 0 To UBound(vNumeric)
  47                 vNewList(iSize + i + 1) = vNumeric(i)
  48         Next i
  49
  50         _AddNumeric = vNewList
  51
  52 End Function            &apos;  _AddNumeric     V0.8.0
  53
  54 REM -----------------------------------------------------------------------------------------------------------------------
  55
  56 Public Function _BitShift(piValue As Integer, piConstant As Integer) As Boolean
  57
  58         _BitShift = False
  59         If piValue = 0 Then Exit Function
  60         Select Case piConstant
  61                 Case 1
  62                         Select Case piValue
  63                                 Case 1, 3, 5, 7, 9, 11, 13, 15:                         _BitShift = True
  64                                 Case Else
  65                         End Select
  66                 Case 2
  67                         Select Case piValue
  68                                 Case 2, 3, 6, 7, 10, 11, 14, 15:                        _BitShift = True
  69                                 Case Else
  70                         End Select
  71                 Case 4
  72                         Select Case piValue
  73                                 Case 4, 5, 6, 7, 12, 13, 14, 15:                        _BitShift = True
  74                                 Case Else
  75                         End Select
  76                 Case 8
  77                         Select Case piValue
  78                                 Case 8, 9, 10, 11, 12, 13, 14, 15:                      _BitShift = True
  79                                 Case Else
  80                         End Select
  81         End Select
  82
  83 End Function            &apos;  BitShift
  84
  85 REM -----------------------------------------------------------------------------------------------------------------------
  86 Public Function _CalledSub() As String
  87         _CalledSub = Iif(_A2B_.CalledSub = &quot;&quot;, &quot;&quot;, _GetLabel(&quot;CALLTO&quot;) &amp; &quot; &apos;&quot; &amp; _A2B_.CalledSub &amp; &quot;&apos;&quot;)
  88 End Function    &apos;  CalledSub       V0.8.9
  89
  90
  91 REM -----------------------------------------------------------------------------------------------------------------------
  92 Public Function _CheckArgument(pvItem As Variant _
  93                         , ByVal piArgNr As Integer _
  94                         , ByVal pvType As Variant _
  95                         , ByVal Optional pvValid As Variant _
  96                         , ByVal Optional pvError As Boolean _
  97                         ) As Variant
  98 &apos;  Called by public functions to check the validity of their arguments
  99 &apos;          pvItem                          Argument to be checked
 100 &apos;          piArgNr                         Argument sequence number
 101 &apos;          pvType                          Single value or array of allowed variable types
 102 &apos;                                                  If of string type must contain one or more valid pseudo-object types
 103 &apos;          pvValid                         Single value or array of allowed values - comparison for strings is case-insensitive
 104 &apos;          pvError                         If True (default), error handling in this routine. False in _setProperty methods in class modules.
 105
 106         _CheckArgument = False
 107
 108 Dim iVarType As Integer, bValidIsMissing As Boolean
 109         If IsArray(pvType) Then iVarType = VarType(pvType(LBound(pvType))) Else iVarType = VarType(pvType)
 110         If iVarType = vbString Then                                     &apos;  pvType is a pseudo-type string
 111                 _CheckArgument = Utils._IsPseudo(pvItem, pvType)
 112         Else
 113                 bValidIsMissing = ( VarType(pvValid) = vbError )
 114                 If Not bValidIsMissing Then bValidIsMissing = IsMissing(pvValid)
 115                 If bValidIsMissing Then _CheckArgument = Utils._IsScalar(pvItem, pvType) Else _CheckArgument = Utils._IsScalar(pvItem, pvType, pvValid)
 116         End If
 117
 118         If VarType(pvItem) = vbCurrency Or VarType(pvItem) = vbDecimal Or VarType(pvItem) = vbBigint Then pvItem = CDbl(pvItem)
 119
 120 Exit_Function:
 121         If Not _CheckArgument Then
 122                 If IsMissing(pvError) Then pvError = True
 123                 If pvError Then
 124                         TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), 0, 1, Array(piArgNr, pvItem))
 125                 End If
 126         End If
 127         Exit Function
 128 End Function    &apos;  CheckArgument   V0.9.0
 129
 130 REM -----------------------------------------------------------------------------------------------------------------------
 131 Public Function _CStr(ByVal pvArg As Variant, ByVal Optional pbShort As Boolean) As String
 132 &apos;  Convert pvArg into a readable string (truncated if too long and pbShort = True or missing)
 133 &apos;  pvArg may be a byte-array. Other arrays are processed recursively into a semicolon separated string
 134
 135 Dim sArg As String, sObject As String, oArg As Object, sLength As String, i As Long, iMax As Long
 136 Const cstLength = 50
 137 Const cstByteLength = 25
 138
 139         If IsMissing(pbShort) Then pbShort = True
 140         If IsArray(pvArg) Then
 141                 sArg = &quot;&quot;
 142                 If VarType(pvArg) = vbByte Or VarType(pvArg) = vbArray + vbByte Then
 143                         If pbShort And UBound(pvArg) &gt; cstByteLength Then iMax = cstByteLength Else iMax = UBound(pvArg)
 144                         For i = 0 To iMax
 145                                 sArg = sArg &amp; Right(&quot;00&quot; &amp; Hex(pvArg(i)), 2)
 146                         Next i
 147                 Else
 148                         If pbShort Then
 149                                 sArg = &quot;[ARRAY]&quot;
 150                         Else    &apos;  One-dimension arrays only
 151                                 For i = LBound(pvArg) To UBound(pvArg)
 152                                         sArg = sArg &amp; Utils._CStr(pvArg(i), pbShort) &amp; &quot;;&quot;    &apos;  Recursive call
 153                                 Next i
 154                                 If Len(sArg) &gt; 1 Then sArg = Left(sArg, Len(sArg) - 1)
 155                         End If
 156                 End If
 157         Else
 158                 Select Case VarType(pvArg)
 159                         Case vbEmpty                    :               sArg = &quot;[EMPTY]&quot;
 160                         Case vbNull                             :               sArg = &quot;[NULL]&quot;
 161                         Case vbObject
 162                                 If IsNull(pvArg) Then
 163                                         sArg = &quot;[NULL]&quot;
 164                                 Else
 165                                         sObject = Utils._ImplementationName(pvArg)
 166                                         If Utils._IsPseudo(pvArg, Array(OBJDATABASE, OBJCOLLECTION, OBJPROPERTY, OBJFORM, OBJSUBFORM, OBJCONTROL, OBJOPTIONGROUP _
 167                                                                 , OBJEVENT, OBJFIELD, OBJTABLEDEF, OBJQUERYDEF, OBJRECORDSET, OBJTEMPVAR, OBJCOMMANDBAR, OBJCOMMANDBARCONTROL _
 168                                                                 , OBJDIALOG _
 169                                                                 )) Then
 170                                                 Set oArg = pvArg                &apos;  To avoid &quot;Object variable not set&quot; error message
 171                                                 sArg = &quot;[&quot; &amp; oArg._Type &amp; &quot;] &quot; &amp; oArg._Name
 172                                         ElseIf sObject &lt;&gt; &quot;&quot; Then
 173                                                 sArg = &quot;[&quot; &amp; sObject &amp; &quot;]&quot;
 174                                         Else
 175                                                 sArg = &quot;[OBJECT]&quot;
 176                                         End If
 177                                 End If
 178                         Case vbVariant                  :               sArg = &quot;[VARIANT]&quot;
 179                         Case vbString
 180                                 &apos;  Replace CR + LF by \n and HT by \t
 181                                 &apos;  Replace semicolon by \; to allow semicolon separated rows
 182                                 sArg = Replace( _
 183                                                         Replace( _
 184                                                                 Replace( _
 185                                                                         Replace( _
 186                                                                                 Replace(pvArg, &quot;\&quot;, &quot;\\&quot;) _
 187                                                                         , Chr(13), &quot;&quot;) _
 188                                                                 , Chr(10), &quot;\n&quot;) _
 189                                                         , Chr(9), &quot;\t&quot;) _
 190                                                 , &quot;;&quot;, &quot;\;&quot;)
 191                         Case vbBoolean                  :               sArg = Iif(pvArg, &quot;[TRUE]&quot;, &quot;[FALSE]&quot;)
 192                         Case vbByte                             :               sArg = Right(&quot;00&quot; &amp; Hex(pvArg), 2)
 193                         Case vbSingle, vbDouble, vbCurrency
 194                                 sArg = Format(pvArg)
 195                                 If InStr(UCase(sArg), &quot;E&quot;) = 0 Then sArg = Format(pvArg, &quot;##0.0##&quot;)
 196                                 sArg = Replace(sArg, &quot;,&quot;, &quot;.&quot;)
 197                         Case vbBigint                   :               sArg = CStr(CLng(pvArg))
 198                         Case vbDate                             :               sArg = Year(pvArg) &amp; &quot;-&quot; &amp; Right(&quot;0&quot; &amp; Month(pvArg), 2) &amp; &quot;-&quot; &amp; Right(&quot;0&quot; &amp; Day(pvArg), 2) _
 199                                                                                                         &amp; &quot; &quot; &amp; Right(&quot;0&quot; &amp; Hour(pvArg), 2) &amp; &quot;:&quot; &amp; Right(&quot;0&quot; &amp; Minute(pvArg), 2) _
 200                                                                                                         &amp; &quot;:&quot; &amp; Right(&quot;0&quot; &amp; Second(pvArg), 2)
 201                         Case Else                               :               sArg = CStr(pvArg)
 202                 End Select
 203         End If
 204         If pbShort And Len(sArg) &gt; cstLength Then
 205                 sLength = &quot;(&quot; &amp; Len(sArg) &amp; &quot;)&quot;
 206                 sArg = Left(sArg, cstLength - 5 - Len(slength)) &amp; &quot; ... &quot; &amp; sLength
 207         End If
 208         _CStr = sArg
 209
 210 End Function    &apos;  CStr                    V0.9.5
 211
 212 REM -----------------------------------------------------------------------------------------------------------------------
 213 Public Function _CVar(ByRef psArg As String, ByVal Optional pbStrDate As Boolean) As Variant
 214 &apos;  psArg is presumed an output of _CStr (stored in the meantime in a text file f.i.)
 215 &apos;  _CVar returns the corresponding original Variant variable or Null/Nothing if not possible
 216 &apos;  Return values may of types Array, Long, Double, Date, Boolean, String, Null or Empty
 217 &apos;  pbStrDate = True keeps dates as strings
 218
 219 Dim cstEscape1 As String, cstEscape2 As String
 220         cstEscape1 = Chr(14)                    &apos;  Form feed used as temporary escape character for \\
 221         cstEscape2 = Chr(27)                    &apos;  ESC used as temporary escape character for \;
 222
 223         _CVar = &quot;&quot;
 224         If Len(psArg) = 0 Then Exit Function
 225
 226 Dim sArg As String, vArgs() As Variant, vVars() As Variant, i As Integer
 227         If IsMissing(pbStrDate) Then pbStrDate = False
 228         sArg = Replace( _
 229                                 Replace( _
 230                                         Replace( _
 231                                                 Replace(psArg, &quot;\\&quot;, cstEscape1) _
 232                                         , &quot;\;&quot;, cstEscape2) _
 233                                 , &quot;\n&quot;, Chr(10)) _
 234                         , &quot;\t&quot;, Chr(9))
 235
 236         &apos;  Semicolon separated string
 237         vArgs = Split(sArg, &quot;;&quot;)
 238         If UBound(vArgs) &gt; LBound(vArgs) Then                &apos;  Process each item recursively
 239                 vVars = Array()
 240                 Redim vVars(LBound(vArgs) To UBound(vArgs))
 241                 For i = LBound(vVars) To UBound(vVars)
 242                         vVars(i) = _CVar(vArgs(i), pbStrDate)
 243                 Next i
 244                 _CVar = vVars
 245                 Exit Function
 246         End If
 247
 248         &apos;  Usual case
 249         Select Case True
 250                 Case sArg = &quot;[EMPTY]&quot;                                         :       _CVar = EMPTY
 251                 Case sArg = &quot;[NULL]&quot; Or sArg = &quot;[VARIANT]&quot;  :       _CVar = Null
 252                 Case sArg = &quot;[OBJECT]&quot;                                                :       _CVar = Nothing
 253                 Case sArg = &quot;[TRUE]&quot;                                          :       _CVar = True
 254                 Case sArg = &quot;[FALSE]&quot;                                         :       _CVar = False
 255                 Case IsDate(sArg)
 256                         If pbStrDate Then _CVar = sArg Else _CVar = CDate(sArg)
 257                 Case IsNumeric(sArg)
 258                         If InStr(sArg, &quot;.&quot;) &gt; 0 Then
 259                                 _CVar = Val(sArg)
 260                         Else
 261                                 _CVar = CLng(Val(sArg))         &apos;  Val always returns a double
 262                         End If
 263                 Case _RegexSearch(sArg, &quot;^[-+]?[0-9]*\.?[0-9]+(e[-+]?[0-9]+)?$&quot;) &lt;&gt; &quot;&quot;
 264                         _CVar = Val(sArg)                                       &apos;  Scientific notation
 265                 Case Else                                                                       :       _CVar = Replace(Replace(sArg, cstEscape1, &quot;\&quot;), cstEscape2, &quot;;&quot;)
 266         End Select
 267
 268 End Function    &apos;  CVar                    V1.7.0
 269
 270 REM -----------------------------------------------------------------------------------------------------------------------
 271 Public Function _DecimalPoint() As String
 272 &apos;Return locale decimal point
 273         _DecimalPoint = Mid(Format(0, &quot;0.0&quot;), 2, 1)
 274 End Function
 275
 276 REM -----------------------------------------------------------------------------------------------------------------------
 277 Private Function _ExtensionLocation() As String
 278 &apos;  Return the URL pointing to the location where OO installed the Access2Base extension
 279 &apos;  Adapted from https://wiki.documentfoundation.org/Documentation/DevGuide/Extensions#Location_of_Installed_Extensions
 280
 281 Dim oPip As Object, sLocation As String
 282         Set oPip = GetDefaultContext.getByName(&quot;/singletons/com.sun.star.deployment.PackageInformationProvider&quot;)
 283         _ExtensionLocation = oPip.getPackageLocation(&quot;Access2Base&quot;)
 284
 285 End Function    &apos;  ExtensionLocation
 286
 287 REM -----------------------------------------------------------------------------------------------------------------------
 288 Private Function _GetDialogLib() As Object
 289 &apos;  Return actual Access2Base dialogs library
 290
 291 Dim oDialogLib As Object
 292
 293         Set oDialogLib = DialogLibraries
 294         If oDialogLib.hasByName(&quot;Access2BaseDev&quot;) Then
 295                 If Not oDialogLib.IsLibraryLoaded(&quot;Access2BaseDev&quot;) Then oDialogLib.loadLibrary(&quot;Access2BaseDev&quot;)
 296                 Set _GetDialogLib = DialogLibraries.Access2BaseDev
 297         ElseIf oDialogLib.hasByName(&quot;Access2Base&quot;) Then
 298                 If Not oDialogLib.IsLibraryLoaded(&quot;Access2Base&quot;) Then oDialogLib.loadLibrary(&quot;Access2Base&quot;)
 299                 Set _GetDialogLib = DialogLibraries.Access2Base
 300         Else
 301                 Set _GetDialogLib = Nothing
 302         EndIf
 303
 304 End Function
 305
 306 REM -----------------------------------------------------------------------------------------------------------------------
 307 Public Function _GetEventName(ByVal psProperty As String) As String
 308 &apos;  Return the LO internal event name
 309 &apos;  Corrects the typo on ErrorOccur(r?)ed
 310
 311         _GetEventName = Replace(LCase(Mid(psProperty, 3, 1)) &amp; Right(psProperty, Len(psProperty) - 3), &quot;errorOccurred&quot;, &quot;errorOccured&quot;)
 312
 313 End Function    &apos;  _GetEventName   V1.7.0
 314
 315 REM -----------------------------------------------------------------------------------------------------------------------
 316 Public Function _GetEventScriptCode(poObject As Object _
 317                                         , ByVal psEvent As String _
 318                                         , ByVal psName As String _
 319                                         , Optional ByVal pbExtendName As Boolean _
 320                                         ) As String
 321 &apos;  Extract from the parent of poObject the macro linked to psEvent.
 322 &apos;  psName is the name of the object
 323
 324 Dim i As Integer, vEvents As Variant, sEvent As String, oParent As Object, iIndex As Integer, sName As String
 325
 326         _GetEventScriptCode = &quot;&quot;
 327         If Not Utils._hasUNOMethod(poObject, &quot;getParent&quot;) Then Exit Function
 328
 329         &apos;  Find form index i.e. find control via getByIndex()
 330         If IsMissing(pbExtendName) Then pbExtendName = False
 331         Set oParent = poObject.getParent()
 332         iIndex = -1
 333         For i = 0 To oParent.getCount() - 1
 334                 sName = oParent.getByIndex(i).Name
 335                 If (sName = psName) Or (pbExtendName And (sName = &quot;MainForm&quot; Or sName = &quot;Form&quot;)) Then
 336                         iIndex = i
 337                         Exit For
 338                 End If
 339         Next i
 340         If iIndex &lt; 0 Then Exit Function
 341
 342         &apos;  Find script event
 343         vEvents = oParent.getScriptEvents(iIndex)                       &apos;  Returns an array
 344         sEvent = Utils._GetEventName(psEvent)                   &apos;  Targeted event method
 345         For i = 0 To UBound(vEvents)
 346                 If vEvents(i).EventMethod = sEvent Then
 347                         _GetEventScriptCode = vEvents(i).ScriptCode
 348                         Exit For
 349                 End If
 350         Next i
 351
 352 End Function    &apos;  _GetEventScriptCode     V1.7.0
 353
 354 REM -----------------------------------------------------------------------------------------------------------------------
 355 Private Function _GetResultSetColumnValue(poResultSet As Object _
 356                                                                                         , ByVal piColIndex As Integer _
 357                                                                                         , Optional ByVal pbReturnBinary As Boolean _
 358                                                                                         ) As Variant
 359 REM Modified from Roberto Benitez&apos;s BaseTools
 360 REM get the data for the column specified by ColIndex
 361 REM If pbReturnBinary = False (default) then return length of binary field
 362 REM get type name from metadata
 363
 364 Dim vValue As Variant, iType As Integer, vDateTime As Variant, oValue As Object
 365 Dim bNullable As Boolean, lSize As Long
 366 Const cstMaxTextLength = 65535
 367 Const cstMaxBinlength = 2 * 65535
 368
 369         On Local Error Goto 0                   &apos;  Disable error handler
 370         vValue = Null                                   &apos;  Default value if error
 371         If IsMissing(pbReturnBinary) Then pbReturnBinary = False
 372         With com.sun.star.sdbc.DataType
 373                 iType = poResultSet.MetaData.getColumnType(piColIndex)
 374                 bNullable = ( poResultSet.MetaData.IsNullable(piColIndex) = com.sun.star.sdbc.ColumnValue.NULLABLE )
 375                 Select Case iType
 376                         Case .ARRAY                                             :               vValue = poResultSet.getArray(piColIndex)
 377                         Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
 378                                                                                                         Set oValue = poResultSet.getBinaryStream(piColIndex)
 379                                                                                                         If bNullable Then
 380                                                                                                                 If Not poResultSet.wasNull() Then
 381                                                                                                                         If Not _hasUNOMethod(oValue, &quot;getLength&quot;) Then        &apos;  When no recordset
 382                                                                                                                                 lSize = cstMaxBinLength
 383                                                                                                                         Else
 384                                                                                                                                 lSize = CLng(oValue.getLength())
 385                                                                                                                         End If
 386                                                                                                                         If lSize &lt;= cstMaxBinLength And pbReturnBinary Then
 387                                                                                                                                 vValue = Array()
 388                                                                                                                                 oValue.readBytes(vValue, lSize)
 389                                                                                                                         Else    &apos;  Return length of field, not content
 390                                                                                                                                 vValue = lSize
 391                                                                                                                         End If
 392                                                                                                                 End If
 393                                                                                                         End If
 394                                                                                                         oValue.closeInput()
 395                         Case .BIT, .BOOLEAN                             :               vValue = poResultSet.getBoolean(piColIndex)
 396                         Case .DATE                                              :               vDateTime = poResultSet.getDate(piColIndex)
 397                                                                                                         If Not poResultSet.wasNull() Then vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day))
 398                         Case .DISTINCT, .OBJECT, .OTHER, .STRUCT
 399                                                                                                         vValue = Null
 400                         Case .DOUBLE, .REAL                             :               vValue = poResultSet.getDouble(piColIndex)
 401                         Case .FLOAT                                             :               vValue = poResultSet.getFloat(piColIndex)
 402                         Case .INTEGER, .SMALLINT                :               vValue = poResultSet.getInt(piColIndex)
 403                         Case .BIGINT                                    :               vValue = poResultSet.getLong(piColIndex)
 404                         Case .DECIMAL, .NUMERIC                 :               vValue = poResultSet.getDouble(piColIndex)
 405                         Case .SQLNULL                                   :               vValue = poResultSet.getNull(piColIndex)
 406                         Case .OBJECT, .OTHER, .STRUCT   :               vValue = Null
 407                         Case .REF                                               :               vValue = poResultSet.getRef(piColIndex)
 408                         Case .TINYINT                                   :               vValue = poResultSet.getShort(piColIndex)
 409                         Case .CHAR, .VARCHAR                    :               vValue = poResultSet.getString(piColIndex)
 410                         Case .LONGVARCHAR, .CLOB
 411                                                                                                         Set oValue = poResultSet.getCharacterStream(piColIndex)
 412                                                                                                         If bNullable Then
 413                                                                                                                 If Not poResultSet.wasNull() Then
 414                                                                                                                         If Not _hasUNOMethod(oValue, &quot;getLength&quot;) Then        &apos;  When no recordset
 415                                                                                                                                 lSize = cstMaxTextLength
 416                                                                                                                         Else
 417                                                                                                                                 lSize = CLng(oValue.getLength())
 418                                                                                                                         End If
 419                                                                                                                         oValue.closeInput()
 420                                                                                                                         vValue = poResultSet.getString(piColIndex)
 421                                                                                                                 End If
 422                                                                                                         Else
 423                                                                                                                 oValue.closeInput()
 424                                                                                                         End If
 425                         Case .TIME                                              :               vDateTime = poResultSet.getTime(piColIndex)
 426                                                                                                         If Not poResultSet.wasNull() Then vValue = TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)&apos;, vDateTime.HundredthSeconds)
 427                         Case .TIMESTAMP                                 :               vDateTime = poResultSet.getTimeStamp(piColIndex)
 428                                                                                                         If Not poResultSet.wasNull() Then vValue = DateSerial(CInt(vDateTime.Year), CInt(vDateTime.Month), CInt(vDateTime.Day)) _
 429                                                                                                                                 + TimeSerial(vDateTime.Hours, vDateTime.Minutes, vDateTime.Seconds)&apos;, vDateTime.HundredthSeconds)
 430                         Case Else
 431                                 vValue = poResultSet.getString(piColIndex)                                              &apos;GIVE STRING A TRY
 432                                 If IsNumeric(vValue) Then vValue = Val(vValue)          &apos;Required when type = &quot;&quot;, sometimes numeric fields are returned as strings (query/MSAccess)
 433                 End Select
 434                 If bNullable Then
 435                         If poResultSet.wasNull() Then vValue = Null
 436                 End If
 437         End With
 438
 439         _GetResultSetColumnValue = vValue
 440
 441 End Function    &apos;  GetResultSetColumnValue         V 1.5.0
 442
 443 REM -----------------------------------------------------------------------------------------------------------------------
 444 Public Function _FinalProperty(psShortcut As String) As String
 445 &apos; Return the final property of a shortcut
 446
 447 Const cstEXCLAMATION = &quot;!&quot;
 448 Const cstDOT = &quot;.&quot;
 449
 450 Dim iCurrentIndex As Integer, vCurrentObject As Variant, sCurrentProperty As String
 451 Dim sComponents() As String, sSubComponents() As String
 452         _FinalProperty = &quot;&quot;
 453         sComponents = Split(Trim(psShortcut), cstEXCLAMATION)
 454         If UBound(sComponents) = 0 Then Exit Function
 455         sSubComponents = Split(sComponents(UBound(sComponents)), cstDOT)
 456         Select Case UBound(sSubComponents)
 457                 Case 1
 458                         _FinalProperty = sSubComponents(1)
 459                 Case Else
 460                         Exit Function
 461         End Select
 462
 463 End Function    &apos;  FinalProperty
 464
 465 REM -----------------------------------------------------------------------------------------------------------------------
 466 Public Function _GetProductName(ByVal Optional psFlag As String) as String
 467 &apos;Return OO product (&quot;PRODUCT&quot;) and version numbers (&quot;VERSION&quot;)
 468 &apos;Derived from Tools library
 469
 470 Dim oProdNameAccess as Object
 471 Dim sVersion as String
 472 Dim sProdName as String
 473         If IsMissing(psFlag) Then psFlag = &quot;ALL&quot;
 474         oProdNameAccess = _GetRegistryKeyContent(&quot;org.openoffice.Setup/Product&quot;)
 475         sProdName = oProdNameAccess.getByName(&quot;ooName&quot;)
 476         sVersion = oProdNameAccess.getByName(&quot;ooSetupVersionAboutBox&quot;)
 477         Select Case psFlag
 478                 Case &quot;ALL&quot;                    :       _GetProductName = sProdName &amp; &quot; &quot; &amp; sVersion
 479                 Case &quot;PRODUCT&quot;                :       _GetProductName = sProdName
 480                 Case &quot;VERSION&quot;                :       _GetProductName = sVersion
 481         End Select
 482 End Function    &apos;  GetProductName          V1.0.0
 483
 484 REM -----------------------------------------------------------------------------------------------------------------------
 485 Public Function _GetRandomFileName(ByVal psName As String) As String
 486 &apos;  Return the full name of a random temporary file suffixed by psName
 487
 488 Dim sRandom As String
 489         sRandom = Right(&quot;000000&quot; &amp; Int(999999 * Rnd), 6)
 490         _GetRandomFileName = Utils._getTempDirectoryURL() &amp; &quot;/&quot; &amp; &quot;A2B_TEMP_&quot; &amp; psName &amp; &quot;_&quot; &amp; sRandom
 491
 492 End Function    &apos;  GetRandomFileName
 493
 494 REM -----------------------------------------------------------------------------------------------------------------------
 495 Public Function _GetRegistryKeyContent(sKeyName as string, Optional bforUpdate as Boolean) As Variant
 496 &apos;Implement ConfigurationProvider service
 497 &apos;Derived from Tools library
 498
 499 Dim oConfigProvider as Object
 500 Dim aNodePath(0) as new com.sun.star.beans.PropertyValue
 501         oConfigProvider = createUnoService(&quot;com.sun.star.configuration.ConfigurationProvider&quot;)
 502         aNodePath(0).Name = &quot;nodepath&quot;
 503         aNodePath(0).Value = sKeyName
 504         If IsMissing(bForUpdate) Then bForUpdate = False
 505         If bForUpdate Then
 506                 _GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments(&quot;com.sun.star.configuration.ConfigurationUpdateAccess&quot;, aNodePath())
 507         Else
 508                 _GetRegistryKeyContent() = oConfigProvider.createInstanceWithArguments(&quot;com.sun.star.configuration.ConfigurationAccess&quot;, aNodePath())
 509         End If
 510 End Function    &apos;  GetRegistryKeyContent   V0.8.5
 511
 512 REM -----------------------------------------------------------------------------------------------------------------------
 513 Public Function _getTempDirectoryURL()  As String
 514 &apos;  Return the temporary directory defined in the OO Options (Paths)
 515 Dim sDirectory As String, oSettings As Object, oPathSettings As Object
 516
 517         If _ErrorHandler() Then On Local Error Goto Error_Function
 518
 519         _getTempDirectoryURL = &quot;&quot;
 520         oPathSettings = createUnoService( &quot;com.sun.star.util.PathSettings&quot; )
 521         sDirectory = oPathSettings.GetPropertyValue( &quot;Temp&quot; )
 522
 523         _getTempDirectoryURL = sDirectory
 524
 525 Exit_Function:
 526         Exit Function
 527 Error_Function:
 528         TraceError(&quot;ERROR&quot;, Err, &quot;_getTempDirectoryURL&quot;, Erl)
 529         _getTempDirectoryURL = &quot;&quot;
 530         Goto Exit_Function
 531 End Function    &apos;  _getTempDirectoryURL            V0.8.5
 532
 533 REM -----------------------------------------------------------------------------------------------------------------------
 534 Public Function _getUNOTypeName(pvObject As Variant) As String
 535 &apos; Return the symbolic name of the pvObject (UNO-object) type
 536 &apos; Code-snippet from XRAY
 537
 538 Dim oService As Object, vClass as Variant
 539         _getUNOTypeName = &quot;&quot;
 540         On Local Error Resume Next
 541         oService = CreateUnoService(&quot;com.sun.star.reflection.CoreReflection&quot;)
 542         vClass = oService.getType(pvObject)
 543         If vClass.TypeClass = com.sun.star.uno.TypeClass.STRUCT  Then
 544                 _getUNOTypeName = vClass.Name
 545         End If
 546         oService.Dispose()
 547
 548 End Function    &apos;  getUNOTypeName
 549
 550 REM -----------------------------------------------------------------------------------------------------------------------
 551 Public Function _hasUNOMethod(pvObject As Variant, psMethod As String) As Boolean
 552 &apos; Return true if pvObject has the (UNO) method psMethod
 553 &apos; Code-snippet found in Bernard Marcelly&apos;s XRAY
 554
 555 Dim vInspect as Variant
 556         _hasUNOMethod = False
 557         If IsNull(pvObject) Then Exit Function
 558         On Local Error Resume Next
 559         vInspect = _A2B_.Introspection.Inspect(pvObject)
 560         _hasUNOMethod = vInspect.hasMethod(psMethod, com.sun.star.beans.MethodConcept.ALL)
 561
 562 End Function    &apos;  hasUNOMethod    V0.8.0
 563
 564 REM -----------------------------------------------------------------------------------------------------------------------
 565 Public Function _hasUNOProperty(pvObject As Variant, psProperty As String) As Boolean
 566 &apos; Return true if pvObject has the (UNO) property psProperty
 567 &apos; Code-snippet found in Bernard Marcelly&apos;s XRAY
 568
 569 Dim vInspect as Variant
 570         _hasUNOProperty = False
 571         If IsNull(pvObject) Then Exit Function
 572         On Local Error Resume Next
 573         vInspect = _A2B_.Introspection.Inspect(pvObject)
 574         _hasUNOProperty = vInspect.hasProperty(psProperty, com.sun.star.beans.PropertyConcept.ALL)
 575
 576 End Function    &apos;  hasUNOProperty  V0.8.0
 577
 578 REM -----------------------------------------------------------------------------------------------------------------------
 579 Public Function _ImplementationName(pvObject As Variant) As String
 580 &apos;  Use getImplementationName method or _getUNOTypeName function
 581
 582 Dim sObjectType As String
 583         On Local Error Resume Next
 584         sObjectType = pvObject.getImplementationName()
 585         If sObjectType = &quot;&quot; Then sObjectType =  _getUNOTypeName(pvObject)
 586
 587         _ImplementationName = sObjectType
 588
 589 End Function            &apos;  ImplementationName
 590
 591 REM -----------------------------------------------------------------------------------------------------------------------
 592 Public Function _InList(ByVal pvItem As Variant, pvList As Variant, ByVal Optional pvReturnValue As Variant, Optional ByVal pbBinarySearch As Boolean) As Variant
 593 &apos;  Return True if pvItem is present in the pvList array (case insensitive comparison)
 594 &apos;  Return the value in pvList if pvReturnValue = True
 595
 596 Dim i As Integer, bFound As Boolean, iListVarType As Integer, iItemVarType As Integer
 597 Dim iTop As Integer, iBottom As Integer, iFound As Integer
 598         iItemVarType = VarType(pvItem)
 599         If IsMissing(pvReturnValue) Then pvReturnValue = False
 600         If iItemVarType = vbNull Or IsNull(pvList) Then
 601                 _InList = False
 602         ElseIf Not IsArray(pvList) Then
 603                 If iItemVarType = vbString Then bFound = ( UCase(pvItem) = UCase(pvList) ) Else bFound = ( pvItem = pvList )
 604                 If Not pvReturnValue Then
 605                         _InList = bFound
 606                 Else
 607                         If bFound Then _InList = pvList Else _InList = False
 608                 End If
 609         ElseIf UBound(pvList) &lt; LBound(pvList) Then          &apos;  Array not initialized
 610                 _InList = False
 611         Else
 612                 bFound = False
 613                 _InList = False
 614                 iListVarType = VarType(pvList(LBound(pvList)))
 615                 If iListVarType = iItemVarType _
 616                         Or ( (iListVarType = vbInteger Or iListVarType = vbLong Or iListVarType = vbSingle Or iListVarType = vbDouble _
 617                                         Or iListVarType = vbCurrency Or iListVarType = vbBigint Or iListVarType = vbDecimal) _
 618                                 And (iItemVarType = vbInteger Or iItemVarType = vbLong Or iItemVarType = vbSingle Or iItemVarType = vbDouble _
 619                                         Or iItemVarType = vbCurrency Or iItemVarType = vbBigint Or iItemVarType = vbDecimal) _
 620                                 ) Then
 621                         If IsMissing(pbBinarySearch) Then pbBinarySearch = False
 622                         If Not pbBinarySearch Then                      &apos;  Linear search
 623                                 For i = LBound(pvList) To UBound(pvList)
 624                                         If iItemVarType = vbString Then bFound = ( UCase(pvItem) = UCase(pvList(i)) ) Else bFound = ( pvItem = pvList(i) )
 625                                         If bFound Then
 626                                                 iFound = i
 627                                                 Exit For
 628                                         End If
 629                                 Next i
 630                         Else                                                            &apos;  Binary search =&gt; array must be sorted
 631                                 iTop = UBound(pvList)
 632                                 iBottom = lBound(pvList)
 633                                 Do
 634                                         iFound = (iTop + iBottom) / 2
 635                                         If ( iItemVarType = vbString And UCase(pvItem) &gt; UCase(pvList(iFound)) ) Or ( iItemVarType &lt;&gt; vbString And pvItem &gt; pvList(iFound) ) Then
 636                                                 iBottom = iFound + 1
 637                                         Else
 638                                                 iTop = iFound - 1
 639                                         End If
 640                                         If iItemVarType = vbString Then bFound = ( UCase(pvItem) = UCase(pvList(iFound)) ) Else bFound = ( pvItem = pvList(iFound) )
 641                                 Loop Until ( bFound ) Or ( iBottom &gt; iTop )
 642                         End If
 643                         If bFound Then
 644                                 If Not pvReturnValue Then _InList = True Else _InList = pvList(iFound)
 645                         End If
 646                 End If
 647         End If
 648
 649         Exit Function
 650
 651 End Function    &apos;  InList V1.1.0
 652
 653 REM -----------------------------------------------------------------------------------------------------------------------
 654 Public Function _InspectPropertyType(poObject As Object, psProperty As String) As String
 655 &apos;Return type of property EVEN WHEN EMPTY ! (Used in date and time controls)
 656
 657 Dim oInspect1 As Object, oInspect2 As Object, oInspect3 As Object
 658 &apos;  On Local Error Resume Next
 659         _InspectPropertyType = &quot;&quot;
 660         Set oInspect1 = CreateUnoService(&quot;com.sun.star.script.Invocation&quot;)
 661         Set oInspect2 = oInspect1.createInstanceWithArguments(Array(poObject)).IntroSpection
 662         If Not IsNull(oInspect2) Then
 663                 Set oInspect3 = oInspect2.getProperty(psProperty, com.sun.star.beans.PropertyConcept.ALL)
 664                 If Not IsNull(oInspect3) Then _InspectPropertyType = oInspect3.Type.Name
 665         End If
 666         Set oInspect1 = Nothing :       Set oInspect2 = Nothing :       Set oInspect3 = Nothing
 667
 668 End Function    &apos;  InspectPropertyType     V1.0.0
 669
 670 REM -----------------------------------------------------------------------------------------------------------------------
 671 Public Function _IsLeft(psString As String, psLeft As String) As Boolean
 672 &apos;  Return True if left part of psString = psLeft
 673
 674 Dim iLength As Integer
 675         iLength = Len(psLeft)
 676         _IsLeft = False
 677         If Len(psString) &gt;= iLength Then
 678                 If Left(psString, iLength) = psLeft Then _IsLeft = True
 679         End If
 680
 681 End Function
 682
 683 REM -----------------------------------------------------------------------------------------------------------------------
 684 Public Function _IsBinaryType(ByVal lType As Long) As Boolean
 685
 686         With com.sun.star.sdbc.DataType
 687                 Select Case lType
 688                         Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
 689                                 _IsBinaryType = True
 690                         Case Else
 691                                 _IsBinaryType = False
 692                 End Select
 693         End With
 694
 695 End Function    &apos;  IsBinaryType    V1.6.0
 696
 697 REM -----------------------------------------------------------------------------------------------------------------------
 698 Public Function _IsPseudo(pvObject As Variant, ByVal pvType As Variant) As Boolean
 699 &apos;  Test pvObject:  does it exist ?
 700 &apos;                                  is the _Type item = one of the proposed pvTypes ?
 701 &apos;                                  does the pseudo-object refer to an existing object (e.g. does the form really exist in the db) ?
 702
 703 Dim bIsPseudo As Boolean, bPseudoExists As Boolean, vObject As Variant
 704
 705         If _ErrorHandler() Then On Local Error Goto Exit_False
 706
 707         _IsPseudo = False
 708         bIsPseudo = False
 709         vObject = pvObject                                      &apos;  To avoid &quot;Object variable not set&quot; error message
 710         Select Case True
 711                 Case IsEmpty(vObject)
 712                 Case IsNull(vObject)
 713                 Case VarType(vObject) &lt;&gt; vbObject
 714                 Case Else
 715                         With vObject
 716                                 Select Case True
 717                                         Case IsEmpty(._Type)
 718                                         Case IsNull(._Type)
 719                                         Case ._Type = &quot;&quot;
 720                                         Case Else
 721                                                 bIsPseudo = _InList(._Type, pvType)
 722                                                 If Not bIsPseudo Then           &apos;  If primary type did not succeed, give the subtype a chance
 723                                                         If ._Type = OBJCONTROL Then bIsPseudo = _InList(._SubType, pvType)
 724                                                 End If
 725                                 End Select
 726                         End With
 727         End Select
 728
 729         If Not bIsPseudo Then Goto Exit_Function
 730
 731 Dim oDoc As Object, oForms As Variant
 732 Const cstSeparator = &quot;\;&quot;
 733
 734         bPseudoExists = False
 735         With vObject
 736                 Select Case ._Type
 737                         Case OBJFORM
 738                                 If ._Name &lt;&gt; &quot;&quot; Then            &apos;  Check validity of form name
 739                                         Set oDoc = _A2B_.CurrentDocument()
 740                                         If oDoc.DbConnect = DBCONNECTFORM Then bPseudoExists = True Else bPseudoExists = _InList(._Name, Application._GetAllHierarchicalNames())
 741                                 End If
 742                         Case OBJDATABASE
 743                                 If ._DbConnect = DBCONNECTFORM Then bPseudoExists = True Else bPseudoExists = Not IsNull(.Connection)
 744                         Case OBJDIALOG
 745                                 If ._Name &lt;&gt; &quot;&quot; Then            &apos;  Check validity of dialog name
 746                                         bPseudoExists = ( _A2B_.hasItem(COLLALLDIALOGS, ._Name) )
 747                                 End If
 748                         Case OBJCOLLECTION
 749                                 bPseudoExists = True
 750                         Case OBJCONTROL
 751                                 If Not IsNull(.ControlModel) And ._Name &lt;&gt; &quot;&quot; Then              &apos;  Check validity of control
 752                                         Set oForms = .ControlModel.Parent
 753                                         bPseudoExists = ( oForms.hasByName(._Name) )
 754                                 End If
 755                         Case OBJSUBFORM
 756                                 If Not IsNull(.DatabaseForm) And ._Name &lt;&gt; &quot;&quot; Then              &apos;  Check validity of subform
 757                                         If .DatabaseForm.ImplementationName = &quot;com.sun.star.comp.forms.ODatabaseForm&quot; Then
 758                                                 Set oForms = .DatabaseForm.Parent
 759                                                 bPseudoExists = ( oForms.hasByName(._Name) )
 760                                         End If
 761                                 End If
 762                         Case OBJOPTIONGROUP
 763                                 bPseudoExists = ( .Count &gt; 0 )
 764                         Case OBJCOMMANDBAR
 765                                 bPseudoExists = ( Not IsNull(._Window) )
 766                         Case OBJCOMMANDBARCONTROL
 767                                 bPseudoExists = ( Not IsNull(._ParentCommandBar) )
 768                         Case OBJEVENT
 769                                 bPseudoExists = ( Not IsNull(._EventSource) )
 770                         Case OBJPROPERTY
 771                                 bPseudoExists = ( ._Name &lt;&gt; &quot;&quot; )
 772                         Case OBJTABLEDEF
 773                                 bPseudoExists = ( ._Name &lt;&gt; &quot;&quot; And Not IsNull(.Table) )
 774                         Case OBJQUERYDEF
 775                                 bPseudoExists = ( ._Name &lt;&gt; &quot;&quot; And Not IsNull(.Query) )
 776                         Case OBJRECORDSET
 777                                 bPseudoExists = ( Not IsNull(.RowSet) )
 778                         Case OBJFIELD
 779                                 bPseudoExists = ( ._Name &lt;&gt; &quot;&quot; And Not IsNull(.Column) )
 780                         Case OBJTEMPVAR
 781                                 If ._Name &lt;&gt; &quot;&quot; Then            &apos;  Check validity of tempvar name
 782                                         bPseudoExists = ( _A2B_.hasItem(COLLTEMPVARS, ._Name) )
 783                                 End If
 784                         Case Else
 785                 End Select
 786         End With
 787
 788         _IsPseudo = ( bIsPseudo And bPseudoExists )
 789
 790 Exit_Function:
 791         Exit Function
 792 Exit_False:
 793         _IsPseudo = False
 794         Goto Exit_Function
 795 End Function    &apos;  IsPseudo                V1.1.0
 796
 797 REM -----------------------------------------------------------------------------------------------------------------------
 798 Private Function _IsScalar(ByVal pvArg As Variant, ByVal pvType As Variant, ByVal Optional pvValid As Variant) As Boolean
 799 &apos;  Check type of pvArg and value in allowed pvValid list
 800
 801         _IsScalar = False
 802
 803         If IsArray(pvType) Then
 804                 If Not _InList(VarType(pvArg), pvType) Then Exit Function
 805         ElseIf VarType(pvArg) &lt;&gt; pvType Then
 806                 If pvType = vbBoolean And VarType(pvArg) = vbLong Then
 807                         If pvArg &lt; -1 And pvArg &gt; 0 Then Exit Function    &apos;  Special boolean processing because the Not function returns a Long
 808                 Else
 809                         Exit Function
 810                 End If
 811         End If
 812         If Not IsMissing(pvValid) Then
 813                 If Not _InList(pvArg, pvValid) Then Exit Function
 814         End If
 815
 816         _IsScalar = True
 817
 818 Exit_Function:
 819         Exit Function
 820 End Function    &apos;  IsScalar        V0.7.5
 821
 822 REM -----------------------------------------------------------------------------------------------------------------------
 823 Public Function _PCase(ByVal psString As String) As String
 824 &apos;  Return the proper case representation of argument
 825
 826 Dim vSubStrings() As Variant, i As Integer, iLen As Integer
 827         vSubStrings = Split(psString, &quot; &quot;)
 828         For i = 0 To UBound(vSubStrings)
 829                 iLen = Len(vSubStrings(i))
 830                 If iLen &gt; 1 Then
 831                         vSubStrings(i) = UCase(Left(vSubStrings(i), 1)) &amp; LCase(Right(vSubStrings(i), iLen - 1))
 832                 ElseIf iLen = 1 Then
 833                         vSubStrings(i) = UCase(vSubStrings(i))
 834                 End If
 835         Next i
 836         _PCase = Join(vSubStrings, &quot; &quot;)
 837
 838 End Function    &apos;  PCase           V0.9.0
 839
 840 REM -----------------------------------------------------------------------------------------------------------------------
 841 Private Function _PercentEncode(ByVal psChar As String) As String
 842 &apos;  Percent encoding of single psChar character
 843 &apos;  https://en.wikipedia.org/wiki/UTF-8
 844
 845 Dim lChar As Long, sByte1 As String, sByte2 As String, sByte3 As String
 846         lChar = Asc(psChar)
 847
 848         Select Case lChar
 849                 Case 48 To 57, 65 To 90, 97 To 122              &apos;  0-9, A-Z, a-z
 850                         _PercentEncode = psChar
 851                 Case Asc(&quot;-&quot;), Asc(&quot;.&quot;), Asc(&quot;_&quot;), Asc(&quot;~&quot;)
 852                         _PercentEncode = psChar
 853                 Case Asc(&quot;!&quot;), Asc(&quot;$&quot;), Asc(&quot;&amp;&quot;), Asc(&quot;&apos;&quot;), Asc(&quot;(&quot;), Asc(&quot;)&quot;), Asc(&quot;*&quot;), Asc(&quot;+&quot;), Asc(&quot;,&quot;), Asc(&quot;;&quot;), Asc(&quot;=&quot;)        &apos;  Reserved characters used as delimiters in query strings
 854                         _PercentEncode = psChar
 855                 Case Asc(&quot; &quot;), Asc(&quot;%&quot;)
 856                         _PercentEncode = &quot;%&quot; &amp; Right(&quot;00&quot; &amp; Hex(lChar), 2)
 857                 Case 0 To 127
 858                         _PercentEncode = psChar
 859                 Case 128 To 2047
 860                         sByte1 = &quot;%&quot; &amp; Right(&quot;00&quot; &amp; Hex(Int(lChar / 64) + 192), 2)
 861                         sByte2 = &quot;%&quot; &amp; Right(&quot;00&quot; &amp; Hex((lChar Mod 64) + 128), 2)
 862                         _PercentEncode = sByte1 &amp; sByte2
 863                 Case 2048 To 65535
 864                         sByte1 = &quot;%&quot; &amp; Right(&quot;00&quot; &amp; Hex(Int(lChar / 4096) + 224), 2)
 865                         sByte2 = &quot;%&quot; &amp; Right(&quot;00&quot; &amp; Hex(Int(lChar - (4096 * Int(lChar / 4096))) /64 + 128), 2)
 866                         sByte3 = &quot;%&quot; &amp; Right(&quot;00&quot; &amp; Hex((lChar Mod 64) + 128), 2)
 867                         _PercentEncode = sByte1 &amp; sByte2 &amp; sByte3
 868                 Case Else                               &apos;  Not supported
 869                         _PercentEncode = psChar
 870         End Select
 871
 872         Exit Function
 873
 874 End Function    &apos;  _PercentEncode V1.4.0
 875
 876 REM -----------------------------------------------------------------------------------------------------------------------
 877 Public Function _ReadFileIntoArray(ByVal psFileName) As Variant
 878 &apos;  Loads all lines of a text file into a Variant array
 879 &apos;  Any error reduces output to an empty array
 880 &apos;  Input file name presumed in URL form
 881
 882 Dim vLines() As Variant, iFile As Integer, sLine As String, iCount1 As Integer, iCount2 As Integer
 883 Const cstMaxLines = 16000               &apos;  +/- the limit of array sizes in Basic
 884         On Local Error GoTo Error_Function
 885         vLines = Array()
 886         _ReadFileIntoArray = Array()
 887         If psFileName = &quot;&quot; Then Exit Function
 888
 889         iFile = FreeFile()
 890         Open psFileName For Input Access Read Shared As #iFile
 891         iCount1 = 0
 892         Do While Not Eof(iFile) And iCount1 &lt; cstMaxLines
 893                 Line Input #iFile, sLine
 894                 iCount1 = iCount1 + 1
 895         Loop
 896         Close #iFile
 897
 898         ReDim vLines(0 To iCount1 - 1)          &apos;  Reading file twice preferred to ReDim Preserve for performance reasons
 899         iFile = FreeFile()
 900         Open psFileName For Input Access Read Shared As #iFile
 901         iCount2 = 0
 902         Do While Not Eof(iFile) And iCount2 &lt; iCount1
 903                 Line Input #iFile, vLines(iCount2)
 904                 iCount2 = iCount2 + 1
 905         Loop
 906         Close #iFile
 907
 908 Exit_Function:
 909         _ReadFileIntoArray() = vLines()
 910         Exit Function
 911 Error_Function:
 912         vLines = Array()
 913         Resume Exit_Function
 914 End Function    &apos;  _ReadFileIntoArray      V1.4.0
 915
 916 REM -----------------------------------------------------------------------------------------------------------------------
 917 Public Function _RegexSearch(ByRef psString As String _
 918                                                 , ByVal psRegex As String _
 919                                                 , Optional ByRef plStart As Long _
 920                                                 , Optional ByVal bForward As Boolean _
 921                                                 ) As String
 922 &apos;  Search is not case-sensitive
 923 &apos;  Return &quot;&quot; if regex not found, otherwise returns the matching string
 924 &apos;  plStart = start position of psString to search (starts at 1)
 925 &apos;  In output plStart contains the first position of the matching string
 926 &apos;  To search again the same or another pattern =&gt; plStart = plStart + Len(matching string)
 927
 928 Dim oTextSearch As Object
 929 Dim vOptions As Variant &apos;com.sun.star.util.SearchOptions
 930 Dim lEnd As Long, vResult As Object
 931
 932         _RegexSearch = &quot;&quot;
 933         Set oTextSearch = _A2B_.TextSearch              &apos;  UNO XTextSearch service
 934         vOptions = _A2B_.SearchOptions
 935         vOptions.searchString = psRegex                         &apos;  Pattern to be searched
 936         oTextSearch.setOptions(vOptions)
 937         If IsMissing(plStart) Then plStart = 1
 938         If plStart &lt;= 0 Or plStart &gt; Len(psString) Then Exit Function
 939         If IsMissing(bForWard) Then bForward = True
 940         If bForward Then
 941                 lEnd = Len(psString)
 942                 vResult = oTextSearch.searchForward(psString, plStart - 1, lEnd)
 943         Else
 944                 lEnd = 1
 945                 vResult = oTextSearch.searchForward(psString, plStart, lEnd - 1)
 946         End If
 947         With vResult
 948                 If .subRegExpressions &gt;= 1 Then
 949                         &apos;  http://www.openoffice.org/api/docs/common/ref/com/sun/star/util/SearchResult.html
 950                         Select Case bForward
 951                                 Case True
 952                                         plStart = .startOffset(0) + 1
 953                                         lEnd = .endOffset(0) + 1
 954                                 Case False
 955                                         plStart = .endOffset(0) + 1
 956                                         lEnd = .startOffset(0)
 957                         End Select
 958                         _RegexSearch = Mid(psString, plStart, lEnd - plStart)
 959                 Else
 960                         plStart = 0
 961                 End If
 962         End With
 963
 964 End Function
 965
 966 REM -----------------------------------------------------------------------------------------------------------------------
 967 Public Function _RegisterDialogEventScript(poObject As Object _
 968                                                                 , ByVal psEvent As String _
 969                                                                 , ByVal psListener As String _
 970                                                                 , ByVal psScriptCode As String _
 971                                                                 ) As Boolean
 972 &apos;  Register a script event (psEvent) to poObject (Dialog or dialog Control)
 973
 974 Dim oEvents As Object, sEvent As String, sEventName As String, oEvent As Object
 975
 976         _RegisterDialogEventScript = False
 977         If Not _hasUNOMethod(poObject, &quot;getEvents&quot;) Then Exit Function
 978
 979 &apos;  Remove existing event, if any, then store new script code
 980         Set oEvents = poObject.getEvents()
 981         sEvent = Utils._GetEventName(psEvent)
 982         sEventName = &quot;com.sun.star.awt.&quot; &amp; psListener &amp; &quot;::&quot; &amp; sEvent
 983         If oEvents.hasByName(sEventName) Then oEvents.removeByName(sEventName)
 984         Set oEvent = CreateUnoStruct(&quot;com.sun.star.script.ScriptEventDescriptor&quot;)
 985         With oEvent
 986                 .ListenerType = psListener
 987                 .EventMethod = sEvent
 988                 .ScriptType = &quot;Script&quot;                        &apos;  Better than &quot;Basic&quot;
 989                 .ScriptCode = psScriptCode
 990         End With
 991         oEvents.insertByName(sEventName, oEvent)
 992
 993         _RegisterDialogEventScript = True
 994
 995 End Function    &apos;  _RegisterDialogEventScript      V1.8.0
 996
 997 REM -----------------------------------------------------------------------------------------------------------------------
 998 Public Function _RegisterEventScript(poObject As Object _
 999                                                                 , ByVal psEvent As String _
1000                                                                 , ByVal psListener As String _
1001                                                                 , ByVal psScriptCode As String _
1002                                                                 , ByVal psName As String _
1003                                                                 , Optional ByVal pbExtendName As Boolean _
1004                                                                 ) As Boolean
1005 &apos;  Register a script event (psEvent) to poObject (Form, SubForm or Control)
1006
1007 Dim i As Integer, oEvent As Object, sEvent As String, oParent As Object, iIndex As Integer, sName As String
1008
1009         _RegisterEventScript = False
1010         If Not _hasUNOMethod(poObject, &quot;getParent&quot;) Then Exit Function
1011
1012         &apos;  Find object internal index i.e. how to reach it via getByIndex()
1013         If IsMissing(pbExtendName) Then pbExtendName = False
1014         Set oParent = poObject.getParent()
1015         iIndex = -1
1016         For i = 0 To oParent.getCount() - 1
1017                 sName = oParent.getByIndex(i).Name
1018                 If (sName = psName) Or (pbExtendName And (sName = &quot;MainForm&quot; Or sName = &quot;Form&quot;)) Then
1019                         iIndex = i
1020                         Exit For
1021                 End If
1022         Next i
1023         If iIndex &lt; 0 Then Exit Function
1024
1025         sEvent = Utils._GetEventName(psEvent)                   &apos;  Targeted event method
1026         If psScriptCode = &quot;&quot; Then
1027                 oParent.revokeScriptEvent(iIndex, psListener, sEvent, &quot;&quot;)
1028         Else
1029                 Set oEvent = CreateUnoStruct(&quot;com.sun.star.script.ScriptEventDescriptor&quot;)
1030                 With oEvent
1031                         .ListenerType = psListener
1032                         .EventMethod = sEvent
1033                         .ScriptType = &quot;Script&quot;                        &apos;  Better than &quot;Basic&quot;
1034                         .ScriptCode = psScriptCode
1035                 End With
1036                 oParent.registerScriptEvent(iIndex, oEvent)
1037         End If
1038         _RegisterEventScript = True
1039
1040 End Function    &apos;  _RegisterEventScript    V1.7.0
1041
1042 REM -----------------------------------------------------------------------------------------------------------------------
1043 Public Sub _ResetCalledSub(ByVal psSub As String)
1044 &apos;  Called in bottom of each public function. _A2B_.CalledSub variable is used for error handling
1045 &apos;  Used to trace routine in/outs and to clarify error messages
1046                 If IsEmpty(_A2B_) Then Call Application._RootInit()     &apos;  Only when Utils module recompiled
1047                 With _A2B_
1048                         If .CalledSub = psSub Then .CalledSub = &quot;&quot;
1049                         If .MinimalTraceLevel = 1 Then TraceLog(TRACEDEBUG, _GetLabel(&quot;Exiting&quot;) &amp; &quot; &quot; &amp; psSub &amp; &quot; ...&quot;, False)
1050                 End With
1051 End Sub                 &apos;  ResetCalledSub
1052
1053 REM -----------------------------------------------------------------------------------------------------------------------
1054 Public Function _RunScript(ByVal psScript As String, Optional pvArgs() As Variant) As Boolean
1055 &apos;  Execute a given script with pvArgs() array of arguments
1056
1057         On Local Error Goto Error_Function
1058         _RunScript = False
1059         If IsNull(ThisComponent) Then Goto Exit_Function
1060
1061 Dim oSCriptProvider As Object, oScript As Object, vResult As Variant
1062
1063         Set oScriptProvider = ThisComponent.ScriptProvider()
1064         Set oScript = oScriptProvider.getScript(psScript)
1065         If IsMissing(pvArgs()) Then pvArgs() = Array()
1066         vResult = oScript.Invoke(pvArgs(), Array(), Array())
1067         _RunScript = True
1068
1069 Exit_Function:
1070         Exit Function
1071 Error_Function:
1072         _RunScript = False
1073         Goto Exit_Function
1074 End Function
1075
1076 REM -----------------------------------------------------------------------------------------------------------------------
1077 Public Sub _SetCalledSub(ByVal psSub As String)
1078 &apos;  Called in top of each public function.
1079 &apos;  Used to trace routine in/outs and to clarify error messages
1080                 If IsEmpty(_A2B_) Then Call Application._RootInit()     &apos;  First use of Access2Base in current LibO/AOO session
1081                 With _A2B_
1082                         If .CalledSub = &quot;&quot; Then
1083                                 .CalledSub = psSub
1084                                 .LastErrorCode = 0
1085                                 .LastErrorLevel = &quot;&quot;
1086                                 .ErrorText = &quot;&quot;
1087                                 .ErrorLongText = &quot;&quot;
1088                         End If
1089                         If .MinimalTraceLevel = 1 Then TraceLog(TRACEDEBUG, _GetLabel(&quot;Entering&quot;) &amp; &quot; &quot; &amp; psSub &amp; &quot; ...&quot;, False)
1090                 End With
1091 End Sub                 &apos;  SetCalledSub
1092
1093 REM -----------------------------------------------------------------------------------------------------------------------
1094 Public Function _Surround(ByVal psName As String) As String
1095 &apos; Return [Name] if Name contains spaces
1096 &apos; Return [Name1].[Name2].[Name3] if Name1.Name2.Name3 contains dots
1097
1098 Const cstSquareOpen = &quot;[&quot;
1099 Const cstSquareClose = &quot;]&quot;
1100 Const cstDot = &quot;.&quot;
1101 Dim sName As String
1102
1103         If InStr(psName, &quot;.&quot;) &gt; 0 Then
1104                 sName = Join(Split(psName, cstDot), cstSquareClose &amp; cstDot &amp; cstSquareOpen)
1105                 _Surround = cstSquareOpen &amp; sName &amp; cstSquareClose
1106         ElseIf InStr(psName, &quot; &quot;) &gt; 0 Then
1107                 _Surround = cstSquareOpen &amp; psName &amp; cstSquareClose
1108         Else
1109                 _Surround = psName
1110         End If
1111
1112 End Function    &apos;  Surround
1113
1114 REM -----------------------------------------------------------------------------------------------------------------------
1115 Public Function _Trim(ByVal psString As String) As String
1116 &apos;  Remove leading and trailing spaces, remove surrounding square brackets, replace tabs by spaces
1117 Const cstSquareOpen = &quot;[&quot;
1118 Const cstSquareClose = &quot;]&quot;
1119 Dim sTrim As String
1120
1121         sTrim = Trim(Replace(psString, vbTab, &quot; &quot;))
1122         _Trim = sTrim
1123         If Len(sTrim) &lt;= 2 Then Exit Function
1124
1125         If Left(sTrim, 1) = cstSquareOpen Then
1126                 If Right(sTrim, 1) = cstSquareClose Then
1127                         _Trim = Mid(sTrim, 2, Len(sTrim) - 2)
1128                 End If
1129         End If
1130 End Function    &apos;  Trim    V0.9.0
1131
1132 REM -----------------------------------------------------------------------------------------------------------------------
1133 Public Function _TrimArray(pvArray As Variant) As Variant
1134 &apos;  Remove empty strings from strings array
1135
1136 Dim sTrim As String, vTrim() As Variant, i As Integer, j As Integer, iCount As Integer
1137         vTrim = Null
1138         If Not IsArray(pvArray) Then
1139                 If Len(Trim(pvArray)) &gt; 0 Then vTrim = Array(pvArray) Else vTrim = Array()
1140         ElseIf UBound(pvArray) &lt; LBound(pvArray) Then                                &apos;  Array empty
1141                 vTrim = Array()
1142         Else
1143                 iCount = 0
1144                 For i = LBound(pvArray) To UBound(pvArray)
1145                         If Len(Trim(pvArray(i))) = 0 Then iCount = iCount + 1
1146                 Next i
1147                 If iCount = 0 Then
1148                         vTrim() = pvArray()
1149                 ElseIf iCount = UBound(pvArray) - LBound(pvArray) + 1 Then      &apos;  Array empty or all blanks
1150                         vTrim() = Array()
1151                 Else
1152                         ReDim vTrim(LBound(pvArray) To UBound(pvArray) - iCount)
1153                         j = 0
1154                         For i = LBound(pvArray) To UBound(pvArray)
1155                                 If Len(Trim(pvArray(i))) &gt; 0 Then
1156                                         vTrim(j) = pvArray(i)
1157                                         j = j + 1
1158                                 End If
1159                         Next i
1160                 End If
1161         End If
1162
1163         _TrimArray() = vTrim()
1164
1165 End Function    &apos;  TrimArray       V0.9.0
1166
1167 REM -----------------------------------------------------------------------------------------------------------------------
1168 Private Function _UpdateResultSetColumnValue(piRDBMS As Integer _
1169                                                                                         , poResultSet As Object _
1170                                                                                         , ByVal piColIndex As Integer _
1171                                                                                         , ByVal pvValue As Variant _
1172                                                                                         ) As Boolean
1173 REM store the pvValue for the column specified by ColIndex
1174 REM get type name from metadata
1175
1176 Dim iType As Integer, vDateTime As Variant, oValue As Object
1177 Dim bNullable As Boolean, lSize As Long, iValueType As Integer, sValueTypeName As String
1178 Const cstMaxTextLength = 65535
1179 Const cstMaxBinlength = 2 * 65535
1180
1181         On Local Error Goto 0                   &apos;  Disable error handler
1182         _UpdateResultSetColumnValue = False
1183         With com.sun.star.sdbc.DataType
1184                 iType = poResultSet.MetaData.getColumnType(piColIndex)
1185                 iValueType = VarType(pvValue)
1186                 sValueTypeName = UCase(poResultSet.MetaData.getColumnTypeName(piColIndex))
1187                 bNullable = ( poResultSet.MetaData.IsNullable(piColIndex) = com.sun.star.sdbc.ColumnValue.NULLABLE )
1188
1189                 If bNullable And IsNull(pvValue) Then
1190                         poResultSet.updateNull(piColIndex)
1191                 Else
1192                         Select Case iType
1193                                 Case .ARRAY, .DISTINCT, .OBJECT, .OTHER, .REF, .SQLNULL, .STRUCT
1194                                                                                                                 poResultSet.updateNull(piColIndex)
1195                                 Case .BINARY, .VARBINARY, .LONGVARBINARY, .BLOB
1196                                                                                                                 poResultSet.updateBytes(piColIndex, pvValue)
1197                                 Case .BIT, .BOOLEAN                             :               poResultSet.updateBoolean(piColIndex, pvValue)
1198                                 Case .DATE                                              :               vDateTime = CreateUnoStruct(&quot;com.sun.star.util.Date&quot;)
1199                                                                                                                 vDateTime.Year = Year(pvValue)
1200                                                                                                                 vDateTime.Month = Month(pvValue)
1201                                                                                                                 vDateTime.Day = Day(pvValue)
1202                                                                                                                 poResultSet.updateDate(piColIndex, vDateTime)
1203                                 Case .DECIMAL, .NUMERIC                 :               poResultSet.updateDouble(piColIndex, pvValue)
1204                                 Case .DOUBLE, .REAL                             :               poResultSet.updateDouble(piColIndex, pvValue)
1205                                 Case .FLOAT                                             :               poResultSet.updateFloat(piColIndex, pvValue)
1206                                 Case .INTEGER, .SMALLINT                :               poResultSet.updateInt(piColIndex, pvValue)
1207                                 Case .BIGINT                                    :               poResultSet.updateLong(piColIndex, pvValue)
1208                                 Case .DECIMAL, .NUMERIC                 :               poResultSet.updateDouble(piColIndex, pvValue)
1209                                 Case .TINYINT                                   :               poResultSet.updateShort(piColIndex, pvValue)
1210                                 Case .CHAR, .VARCHAR, .LONGVARCHAR, .CLOB
1211                                                                                                                 If piRDBMS = DBMS_SQLITE And InStr(sValueTypeName, &quot;BINARY&quot;) &gt; 0 Then              &apos;  Sqlite exception ... !
1212                                                                                                                         poResultSet.updateBytes(piColIndex, pvValue)
1213                                                                                                                 Else
1214                                                                                                                         poResultSet.updateString(piColIndex, pvValue)
1215                                                                                                                 End If
1216                                 Case .TIME                                              :               vDateTime = CreateUnoStruct(&quot;com.sun.star.util.Time&quot;)
1217                                                                                                                 vDateTime.Hours = Hour(pvValue)
1218                                                                                                                 vDateTime.Minutes = Minute(pvValue)
1219                                                                                                                 vDateTime.Seconds = Second(pvValue)
1220                                                                                                                 &apos;vDateTime.HundredthSeconds = 0
1221                                                                                                                 poResultSet.updateTime(piColIndex, vDateTime)
1222                                 Case .TIMESTAMP                                 :               vDateTime = CreateUnoStruct(&quot;com.sun.star.util.DateTime&quot;)
1223                                                                                                                 vDateTime.Year = Year(pvValue)
1224                                                                                                                 vDateTime.Month = Month(pvValue)
1225                                                                                                                 vDateTime.Day = Day(pvValue)
1226                                                                                                                 vDateTime.Hours = Hour(pvValue)
1227                                                                                                                 vDateTime.Minutes = Minute(pvValue)
1228                                                                                                                 vDateTime.Seconds = Second(pvValue)
1229                                                                                                                 &apos;vDateTime.HundredthSeconds = 0
1230                                                                                                                 poResultSet.updateTimestamp(piColIndex, vDateTime)
1231                                 Case Else
1232                                         If bNullable Then poResultSet.updateNull(piColIndex)
1233                         End Select
1234                 End If
1235
1236         End With
1237
1238         _UpdateResultSetColumnValue = True
1239
1240 End Function    &apos;  UpdateResultSetColumnValue              V 1.6.0
1241
1242 REM -----------------------------------------------------------------------------------------------------------------------
1243 Private Function _URLEncode(ByVal psToEncode As String) As String
1244 &apos;  http://www.w3schools.com/tags/ref_urlencode.asp
1245 &apos;  http://xkr.us/articles/javascript/encode-compare/
1246 &apos;  http://tools.ietf.org/html/rfc3986
1247
1248 Dim sEncoded As String, sChar As String
1249 Dim lCurrentChar As Long, bQuestionMark As Boolean
1250
1251         sEncoded = &quot;&quot;
1252         bQuestionMark = False
1253         For lCurrentChar = 1 To Len(psToEncode)
1254                 sChar = Mid(psToEncode, lCurrentChar, 1)
1255                 Select Case sChar
1256                         Case &quot; &quot;, &quot;%&quot;
1257                                 sEncoded = sEncoded &amp; _PercentEncode(sChar)
1258                         Case &quot;?&quot;                                      &apos;  Is it the first &quot;?&quot; ?
1259                                 If bQuestionMark Then                   &apos;  &quot;?&quot; introduces in a URL the arguments part
1260                                         sEncoded = sEncoded &amp; _PercentEncode(sChar)
1261                                 Else
1262                                         sEncoded = sEncoded &amp; sChar
1263                                         bQuestionMark = True
1264                                 End If
1265                         Case &quot;\&quot;
1266                                 If bQuestionMark Then
1267                                         sEncoded = sEncoded &amp; _PercentEncode(sChar)
1268                                 Else
1269                                         sEncoded = sEncoded &amp; &quot;/&quot; &apos;  If Windows file naming ...
1270                                 End If
1271                         Case Else
1272                                 If bQuestionMark Then
1273                                         sEncoded = sEncoded &amp; _PercentEncode(sChar)
1274                                 Else
1275                                         sEncoded = sEncoded &amp; _UTF8Encode(sChar)    &apos;  Because IE does not support %encoding in first part of URL
1276                                 End If
1277                 End Select
1278         Next lCurrentChar
1279
1280         _URLEncode = sEncoded
1281
1282 End Function    &apos;  _URLEncode V1.4.0
1283
1284 REM -----------------------------------------------------------------------------------------------------------------------
1285 Private Function _UTF8Encode(ByVal psChar As String) As String
1286 &apos;  &amp;-encoding of single psChar character (e.g. &quot;é&quot; becomes &quot;&amp;eacute;&quot; or numeric equivalent
1287 &apos;  http://www.w3schools.com/charsets/ref_html_utf8.asp
1288
1289         Select Case psChar
1290                 Case &quot;&quot;&quot;&quot;                   :       _UTF8Encode = &quot;&amp;quot;&quot;
1291                 Case &quot;&amp;&quot;                  :       _UTF8Encode = &quot;&amp;amp;&quot;
1292                 Case &quot;&lt;&quot;                   :       _UTF8Encode = &quot;&amp;lt;&quot;
1293                 Case &quot;&gt;&quot;                   :       _UTF8Encode = &quot;&amp;gt;&quot;
1294                 Case &quot;&apos;&quot;                 :       _UTF8Encode = &quot;&amp;apos;&quot;
1295                 Case &quot;:&quot;, &quot;/&quot;, &quot;?&quot;, &quot;#&quot;, &quot;[&quot;, &quot;]&quot;, &quot;@&quot;                            &apos;  Reserved characters
1296                         _UTF8Encode = psChar
1297                 Case Chr(13)            :       _UTF8Encode = &quot;&quot;                      &apos;  Carriage return
1298                 Case Chr(10)            :       _UTF8Encode = &quot;&lt;br&gt;&quot;            &apos;  Line Feed
1299                 Case &lt; Chr(126)              :       _UTF8Encode = psChar
1300                 Case &quot;€&quot;                    :       _UTF8Encode = &quot;&amp;euro;&quot;
1301                 Case Else                       :       _UTF8Encode = &quot;&amp;#&quot; &amp; Asc(psChar) &amp; &quot;;&quot;
1302         End Select
1303
1304         Exit Function
1305
1306 End Function    &apos;  _UTF8Encode V1.4.0
1307
1308 </script:module>