wizards/source/access2base/DataDef.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="DataDef" script:language="StarBasic">REM =======================================================================================================================
   4 REM ===                                 The Access2Base library is a part of the LibreOffice project.                                                                   ===
   5 REM ===                                 Full documentation is available on http://www.access2base.com                                                                   ===
   6 REM =======================================================================================================================
   7
   8 Option Compatible
   9 Option ClassModule
  10
  11 Option Explicit
  12
  13 REM -----------------------------------------------------------------------------------------------------------------------
  14 REM --- CLASS ROOT FIELDS                                                                                                                                                                                       ---
  15 REM -----------------------------------------------------------------------------------------------------------------------
  16
  17 Private _Type                                   As String                               &apos;  Must be TABLEDEF or QUERYDEF
  18 Private _Name                                   As String                               &apos;  For tables: [[Catalog.]Schema.]Table
  19 Private _ParentDatabase                 As Object
  20 Private _ReadOnly                               As Boolean
  21 Private Table                                   As Object                               &apos;  com.sun.star.sdb.dbaccess.ODBTable
  22 Private CatalogName                             As String
  23 Private SchemaName                              As String
  24 Private TableName                               As String
  25 Private Query                                   As Object                               &apos;  com.sun.star.sdb.dbaccess.OQuery
  26 Private TableDescriptor                 As Object                               &apos;  com.sun.star.sdb.dbaccess.ODBTable
  27 Private TableFieldsCount                As Integer
  28 Private TableKeysCount                  As Integer
  29
  30 REM -----------------------------------------------------------------------------------------------------------------------
  31 REM --- CONSTRUCTORS / DESTRUCTORS                                                                                                                                                                      ---
  32 REM -----------------------------------------------------------------------------------------------------------------------
  33 Private Sub Class_Initialize()
  34         _Type = &quot;&quot;
  35         _Name = &quot;&quot;
  36         Set _ParentDatabase = Nothing
  37         _ReadOnly = False
  38         Set Table = Nothing
  39         CatalogName = &quot;&quot;
  40         SchemaName = &quot;&quot;
  41         TableName = &quot;&quot;
  42         Set Query = Nothing
  43         Set TableDescriptor = Nothing
  44         TableFieldsCount = 0
  45         TableKeysCount = 0
  46 End Sub         &apos;  Constructor
  47
  48 REM -----------------------------------------------------------------------------------------------------------------------
  49 Private Sub Class_Terminate()
  50         On Local Error Resume Next
  51         Call Class_Initialize()
  52 End Sub         &apos;  Destructor
  53
  54 REM -----------------------------------------------------------------------------------------------------------------------
  55 Public Sub Dispose()
  56         Call Class_Terminate()
  57 End Sub         &apos;  Explicit destructor
  58
  59 REM -----------------------------------------------------------------------------------------------------------------------
  60 REM --- CLASS GET/LET/SET PROPERTIES                                                                                                                                                            ---
  61 REM -----------------------------------------------------------------------------------------------------------------------
  62
  63 Property Get Name() As String
  64         Name = _PropertyGet(&quot;Name&quot;)
  65 End Property            &apos;  Name (get)
  66
  67 REM -----------------------------------------------------------------------------------------------------------------------
  68 Property Get ObjectType() As String
  69         ObjectType = _PropertyGet(&quot;ObjectType&quot;)
  70 End Property            &apos;  ObjectType (get)
  71
  72 REM -----------------------------------------------------------------------------------------------------------------------
  73 Property Get SQL() As Variant
  74         SQL = _PropertyGet(&quot;SQL&quot;)
  75 End Property            &apos;  SQL (get)
  76
  77 Property Let SQL(ByVal pvValue As Variant)
  78         Call _PropertySet(&quot;SQL&quot;, pvValue)
  79 End Property            &apos;  SQL (set)
  80
  81 REM -----------------------------------------------------------------------------------------------------------------------
  82 Public Function pType() As Integer
  83         pType = _PropertyGet(&quot;Type&quot;)
  84 End Function            &apos;  Type (get)
  85
  86 REM -----------------------------------------------------------------------------------------------------------------------
  87 REM --- CLASS METHODS                                                                                                                                                                                           ---
  88 REM -----------------------------------------------------------------------------------------------------------------------
  89
  90 Public Function CreateField(ByVal Optional pvFieldName As Variant _
  91                                                                 , ByVal optional pvType As Variant _
  92                                                                 , ByVal optional pvSize As Variant _
  93                                                                 , ByVal optional pvAttributes As variant _
  94                                                                 ) As Object
  95 &apos;Return a Field object
  96 Const cstThisSub = &quot;TableDef.CreateField&quot;
  97         Utils._SetCalledSub(cstThisSub)
  98
  99         If _ErrorHandler() Then On Local Error Goto Error_Function
 100
 101 Dim oTable As Object, oNewField As Object, oKeys As Object, oPrimaryKey As Object, oColumn As Object
 102 Const cstMaxKeyLength = 30
 103
 104         CreateField = Nothing
 105         If _ParentDatabase._DbConnect &lt;&gt; DBCONNECTBASE Then Goto Error_NotApplicable
 106         If IsMissing(pvFieldName) Then Call _TraceArguments()
 107         If Not Utils._CheckArgument(pvFieldName, 1, vbString) Then Goto Exit_Function
 108         If pvFieldName = &quot;&quot; Then Call _TraceArguments()
 109         If IsMissing(pvType) Then Call _TraceArguments()
 110         If Not Utils._CheckArgument(pvType, 1, Utils._AddNumeric( _
 111                                                 dbInteger, dbLong, dbBigInt, dbFloat, vbSingle, dbDouble _
 112                                                 , dbNumeric, dbDecimal, dbText, dbChar, dbMemo _
 113                                                 , dbDate, dbTime, dbTimeStamp _
 114                                                 , dbBinary, dbVarBinary, dbLongBinary, dbBoolean _
 115                                         )) Then Goto Exit_Function
 116         If IsMissing(pvSize) Then pvSize = 0
 117         If pvSize &lt; 0 Then pvSize = 0
 118         If Not Utils._CheckArgument(pvSize, 1, Utils._AddNumeric()) Then Goto Exit_Function
 119         If IsMissing(pvAttributes) Then pvAttributes = 0
 120         If Not Utils._CheckArgument(pvAttributes, 1, Utils._AddNumeric(), Array(0, dbAutoIncrField)) Then Goto Exit_Function
 121
 122         If _Type &lt;&gt; OBJTABLEDEF Then Goto Error_NotApplicable
 123         If IsNull(Table) And IsNull(TableDescriptor) Then Goto Error_NotApplicable
 124
 125         If _ReadOnly Then Goto Error_NoUpdate
 126
 127         Set oNewField = New Field
 128         With oNewField
 129                 ._Name = pvFieldName
 130                 ._ParentName = _Name
 131                 ._ParentType = OBJTABLEDEF
 132                 If IsNull(Table) Then Set oTable = TableDescriptor Else Set oTable = Table
 133                 Set .Column = oTable.Columns.createDataDescriptor()
 134         End With
 135         With oNewField.Column
 136                 .Name = pvFieldName
 137                 Select Case pvType
 138                         Case dbInteger                          :       .Type = com.sun.star.sdbc.DataType.TINYINT
 139                         Case dbLong                                     :       .Type = com.sun.star.sdbc.DataType.INTEGER
 140                         Case dbBigInt                           :       .Type = com.sun.star.sdbc.DataType.BIGINT
 141                         Case dbFloat                            :       .Type = com.sun.star.sdbc.DataType.FLOAT
 142                         Case dbSingle                           :       .Type = com.sun.star.sdbc.DataType.REAL
 143                         Case dbDouble                           :       .Type = com.sun.star.sdbc.DataType.DOUBLE
 144                         Case dbNumeric, dbCurrency      :       .Type = com.sun.star.sdbc.DataType.NUMERIC
 145                         Case dbDecimal                          :       .Type = com.sun.star.sdbc.DataType.DECIMAL
 146                         Case dbText                                     :       .Type = com.sun.star.sdbc.DataType.CHAR
 147                         Case dbChar                                     :       .Type = com.sun.star.sdbc.DataType.VARCHAR
 148                         Case dbMemo                                     :       .Type = com.sun.star.sdbc.DataType.LONGVARCHAR
 149                         Case dbDate                                     :       .Type = com.sun.star.sdbc.DataType.DATE
 150                         Case dbTime                                     :       .Type = com.sun.star.sdbc.DataType.TIME
 151                         Case dbTimeStamp                        :       .Type = com.sun.star.sdbc.DataType.TIMESTAMP
 152                         Case dbBinary                           :       .Type = com.sun.star.sdbc.DataType.BINARY
 153                         Case dbVarBinary                        :       .Type = com.sun.star.sdbc.DataType.VARBINARY
 154                         Case dbLongBinary                       :       .Type = com.sun.star.sdbc.DataType.LONGVARBINARY
 155                         Case dbBoolean                          :       .Type = com.sun.star.sdbc.DataType.BOOLEAN
 156                 End Select
 157                 .Precision = Int(pvSize)
 158                 If pvType = dbNumeric Or pvType = dbDecimal Or pvType = dbCurrency Then .Scale = Int(pvSize * 10) - Int(pvSize) * 10
 159                 .IsNullable = com.sun.star.sdbc.ColumnValue.NULLABLE
 160                 If Utils._hasUNOProperty(oNewField.Column, &quot;CatalogName&quot;) Then .CatalogName = CatalogName
 161                 If Utils._hasUNOProperty(oNewField.Column, &quot;SchemaName&quot;) Then .SchemaName = SchemaName
 162                 If Utils._hasUNOProperty(oNewField.Column, &quot;TableName&quot;) Then .TableName = TableName
 163                 If Not IsNull(TableDescriptor) Then TableFieldsCount = TableFieldsCount + 1
 164                 If pvAttributes = dbAutoIncrField Then
 165                         If Not IsNull(Table) Then Goto Error_Sequence                   &apos;  Do not accept adding an AutoValue field when table exists
 166                         Set oKeys = oTable.Keys
 167                         Set oPrimaryKey = oKeys.createDataDescriptor()
 168                         Set oColumn = oPrimaryKey.Columns.createDataDescriptor()
 169                         oColumn.Name = pvFieldName
 170                         oColumn.CatalogName = CatalogName
 171                         oColumn.SchemaName = SchemaName
 172                         oColumn.TableName = TableName
 173                         oColumn.IsAutoIncrement = True
 174                         oColumn.IsNullable = com.sun.star.sdbc.ColumnValue.NO_NULLS
 175                         oPrimaryKey.Columns.appendByDescriptor(oColumn)
 176                         oPrimaryKey.Name = Left(&quot;PK_&quot; &amp; Join(Split(TableName, &quot; &quot;), &quot;_&quot;) &amp; &quot;_&quot; &amp; Join(Split(pvFieldName, &quot; &quot;), &quot;_&quot;), cstMaxKeyLength)
 177                         oPrimaryKey.Type = com.sun.star.sdbcx.KeyType.PRIMARY
 178                         oKeys.appendByDescriptor(oPrimaryKey)
 179                         .IsAutoIncrement = True
 180                         .IsNullable = com.sun.star.sdbc.ColumnValue.NO_NULLS
 181                         oColumn.dispose()
 182                 Else
 183                         .IsAutoIncrement = False
 184                 End If
 185         End With
 186         oTable.Columns.appendByDescriptor(oNewfield.Column)
 187
 188         Set CreateField = oNewField
 189
 190 Exit_Function:
 191         Utils._ResetCalledSub(cstThisSub)
 192         Exit Function
 193 Error_Function:
 194         TraceError(TRACEABORT, Err, cstThisSub, Erl)
 195         GoTo Exit_Function
 196 Error_NotApplicable:
 197         TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
 198         Goto Exit_Function
 199 Error_Sequence:
 200         TraceError(TRACEFATAL, ERRFIELDCREATION, Utils._CalledSub(), 0, 1, pvFieldName)
 201         Goto Exit_Function
 202 Error_NoUpdate:
 203         TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0)
 204         Goto Exit_Function
 205 End Function    &apos;  CreateField     V1.1.0
 206
 207 REM -----------------------------------------------------------------------------------------------------------------------
 208 Public Function Execute(ByVal Optional pvOptions As Variant) As Boolean
 209 &apos;Execute a stored query. The query must be an ACTION query.
 210
 211 Dim cstThisSub As String
 212         cstThisSub = Utils._PCase(_Type) &amp; &quot;.Execute&quot;
 213         Utils._SetCalledSub(cstThisSub)
 214         On Local Error Goto Error_Function
 215 Const cstNull = -1
 216         Execute = False
 217         If _Type &lt;&gt; OBJQUERYDEF Then Goto Trace_Method
 218         If IsMissing(pvOptions) Then
 219                 pvOptions = cstNull
 220         Else
 221                 If Not Utils._CheckArgument(pvOptions, 1, Utils._AddNumeric(), dbSQLPassThrough) Then Goto Exit_Function
 222         End If
 223
 224         &apos;Check action query
 225 Dim oStatement As Object, vResult As Variant
 226 Dim iType As Integer, sSql As String
 227         iType = pType
 228         If ( (iType And DBQAction) = 0 ) And ( (iType And DBQDDL) = 0 ) Then Goto Trace_Action
 229
 230         &apos;Execute action query
 231         Set oStatement = _ParentDatabase.Connection.createStatement()
 232         sSql = Query.Command
 233         If pvOptions = dbSQLPassThrough Then oStatement.EscapeProcessing = False _
 234                                                                         Else oStatement.EscapeProcessing = Query.EscapeProcessing
 235         On Local Error Goto SQL_Error
 236         vResult = oStatement.executeUpdate(_ParentDatabase._ReplaceSquareBrackets(sSql))
 237         On Local Error Goto Error_Function
 238
 239         Execute = True
 240
 241 Exit_Function:
 242         Utils._ResetCalledSub(cstThisSub)
 243         Exit Function
 244 Trace_Method:
 245         TraceError(TRACEFATAL, ERRMETHOD, cstThisSub, 0, , cstThisSub)
 246         Goto Exit_Function
 247 Trace_Action:
 248         TraceError(TRACEFATAL, ERRNOTACTIONQUERY, cstThisSub, 0, , _Name)
 249         Goto Exit_Function
 250 SQL_Error:
 251         TraceError(TRACEFATAL, ERRSQLSTATEMENT, Utils._CalledSub(), 0, , sSql)
 252         Goto Exit_Function
 253 Error_Function:
 254         TraceError(TRACEABORT, Err, cstThisSub, Erl)
 255         GoTo Exit_Function
 256 End Function            &apos;  Execute V1.1.0
 257
 258 REM -----------------------------------------------------------------------------------------------------------------------
 259 Public Function Fields(ByVal Optional pvIndex As variant) As Object
 260
 261         If _ErrorHandler() Then On Local Error Goto Error_Function
 262 Dim cstThisSub As String
 263         cstThisSub = Utils._PCase(_Type) &amp; &quot;.Fields&quot;
 264         Utils._SetCalledSub(cstThisSub)
 265
 266         Set Fields = Nothing
 267         If Not IsMissing(pvIndex) Then
 268                 If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
 269         End If
 270
 271 Dim sObjects() As String, sObjectName As String, oObject As Object
 272 Dim i As Integer, bFound As Boolean, oFields As Object
 273
 274         If _Type = OBJTABLEDEF Then Set oFields = Table.getColumns() Else Set oFields = Query.getColumns()
 275         sObjects = oFields.ElementNames()
 276         Select Case True
 277                 Case IsMissing(pvIndex)
 278                         Set oObject = New Collect
 279                         oObject._CollType = COLLFIELDS
 280                         oObject._ParentType = _Type
 281                         oObject._ParentName = _Name
 282                         Set oObject._ParentDatabase = _ParentDatabase
 283                         oObject._Count = UBound(sObjects) + 1
 284                         Goto Exit_Function
 285                 Case VarType(pvIndex) = vbString
 286                         bFound = False
 287                 &apos;  Check existence of object and find its exact (case-sensitive) name
 288                         For i = 0 To UBound(sObjects)
 289                                 If UCase(pvIndex) = UCase(sObjects(i)) Then
 290                                         sObjectName = sObjects(i)
 291                                         bFound = True
 292                                         Exit For
 293                                 End If
 294                         Next i
 295                         If Not bFound Then Goto Trace_NotFound
 296                 Case Else               &apos;  pvIndex is numeric
 297                         If pvIndex &lt; 0 Or pvIndex &gt; UBound(sObjects) Then Goto Trace_IndexError
 298                         sObjectName = sObjects(pvIndex)
 299         End Select
 300
 301         Set oObject = New Field
 302         oObject._Name = sObjectName
 303         Set oObject.Column = oFields.getByName(sObjectName)
 304         oObject._ParentName = _Name
 305         oObject._ParentType = _Type
 306         Set oObject._ParentDatabase = _ParentDatabase
 307
 308 Exit_Function:
 309         Set Fields = oObject
 310         Set oObject = Nothing
 311         Utils._ResetCalledSub(cstThisSub)
 312         Exit Function
 313 Error_Function:
 314         TraceError(TRACEABORT, Err, cstThisSub, Erl)
 315         GoTo Exit_Function
 316 Trace_NotFound:
 317         TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(&quot;FIELD&quot;), pvIndex))
 318         Goto Exit_Function
 319 Trace_IndexError:
 320         TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0)
 321         Goto Exit_Function
 322 End Function            &apos;  Fields
 323
 324 REM -----------------------------------------------------------------------------------------------------------------------
 325 Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
 326 &apos;  Return property value of psProperty property name
 327
 328 Dim cstThisSub As String
 329         cstThisSub = Utils._PCase(_Type) &amp; &quot;.getProperty&quot;
 330         Utils._SetCalledSub(cstThisSub)
 331         If IsMissing(pvProperty) Then Call _TraceArguments()
 332         getProperty = _PropertyGet(pvProperty)
 333         Utils._ResetCalledSub(cstThisSub)
 334
 335 End Function            &apos;  getProperty
 336
 337 REM -----------------------------------------------------------------------------------------------------------------------
 338 Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
 339 &apos;  Return True if object has a valid property called pvProperty (case-insensitive comparison !)
 340
 341 Dim cstThisSub As String
 342         cstThisSub = Utils._PCase(_Type) &amp; &quot;.hasProperty&quot;
 343         Utils._SetCalledSub(cstThisSub)
 344         If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
 345         Utils._ResetCalledSub(cstThisSub)
 346         Exit Function
 347
 348 End Function    &apos;  hasProperty
 349
 350 REM -----------------------------------------------------------------------------------------------------------------------
 351 Public Function OpenRecordset(ByVal Optional pvType As Variant, ByVal Optional pvOptions As Variant, ByVal Optional pvLockEdit As Variant) As Object
 352 &apos;Return a Recordset object based on current table- or querydef object
 353
 354 Dim cstThisSub As String
 355         cstThisSub = Utils._PCase(_Type) &amp; &quot;.OpenRecordset&quot;
 356         Utils._SetCalledSub(cstThisSub)
 357 Const cstNull = -1
 358 Dim lCommandType As Long, sCommand As String, oObject As Object,bPassThrough As Boolean
 359
 360         Set oObject = Nothing
 361         If IsMissing(pvType) Then
 362                 pvType = cstNull
 363         Else
 364                 If Not Utils._CheckArgument(pvType, 1, Utils._AddNumeric(), dbOpenForwardOnly) Then Goto Exit_Function
 365         End If
 366         If IsMissing(pvOptions) Then
 367                 pvOptions = cstNull
 368         Else
 369                 If Not Utils._CheckArgument(pvOptions, 2, Utils._AddNumeric(), dbSQLPassThrough) Then Goto Exit_Function
 370         End If
 371         If IsMissing(pvLockEdit) Then
 372                 pvLockEdit = cstNull
 373         Else
 374                 If Not Utils._CheckArgument(pvLockEdit, 3, Utils._AddNumeric(), dbReadOnly) Then Goto Exit_Function
 375         End If
 376
 377         Select Case _Type
 378                 Case OBJTABLEDEF
 379                         lCommandType = com.sun.star.sdb.CommandType.TABLE
 380                         sCommand = _Name
 381                 Case OBJQUERYDEF
 382                         lCommandType = com.sun.star.sdb.CommandType.QUERY
 383                         sCommand = _Name
 384                         If pvOptions = dbSQLPassThrough Then bPassThrough = True Else bPassThrough = Not Query.EscapeProcessing
 385         End Select
 386
 387         Set oObject = New Recordset
 388         With oObject
 389                 ._CommandType = lCommandType
 390                 ._Command = sCommand
 391                 ._ParentName = _Name
 392                 ._ParentType = _Type
 393                 ._ForwardOnly = ( pvType = dbOpenForwardOnly )
 394                 ._PassThrough = bPassThrough
 395                 ._ReadOnly = ( (pvLockEdit = dbReadOnly) Or _ReadOnly )
 396                 Set ._ParentDatabase = _ParentDatabase
 397                 Set ._This = oObject
 398                 Call ._Initialize()
 399         End With
 400         With _ParentDatabase
 401                 .RecordsetMax = .RecordsetMax + 1
 402                 oObject._Name = Format(.RecordsetMax, &quot;0000000&quot;)
 403                 .RecordsetsColl.Add(oObject, UCase(oObject._Name))
 404         End With
 405
 406         If Not ( oObject._BOF And oObject._EOF ) Then oObject.MoveFirst()               &apos;  Do nothing if resultset empty
 407
 408 Exit_Function:
 409         Set OpenRecordset = oObject
 410         Set oObject = Nothing
 411         Utils._ResetCalledSub(cstThisSub)
 412         Exit Function
 413 Error_Function:
 414         TraceError(TRACEABORT, Err, cstThisSub, Erl)
 415         Set oObject = Nothing
 416         GoTo Exit_Function
 417 End Function    &apos;  OpenRecordset V1.1.0
 418
 419 REM -----------------------------------------------------------------------------------------------------------------------
 420 Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
 421 &apos;  Return
 422 &apos;          a Collection object if pvIndex absent
 423 &apos;          a Property object otherwise
 424
 425 Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
 426 Dim cstThisSub As String
 427         cstThisSub = Utils._PCase(_Type) &amp; &quot;.Properties&quot;
 428         Utils._SetCalledSub(cstThisSub)
 429         vPropertiesList = _PropertiesList()
 430         sObject = Utils._PCase(_Type)
 431         If IsMissing(pvIndex) Then
 432                 vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList)
 433         Else
 434                 vProperty = PropertiesGet._Properties(sObject, _Name, vPropertiesList, pvIndex)
 435                 vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
 436         End If
 437         Set vProperty._ParentDatabase = _ParentDatabase
 438
 439 Exit_Function:
 440         Set Properties = vProperty
 441         Utils._ResetCalledSub(cstThisSub)
 442         Exit Function
 443 End Function    &apos;  Properties
 444
 445 REM -----------------------------------------------------------------------------------------------------------------------
 446 Public Function setProperty(ByVal Optional psProperty As String, ByVal Optional pvValue As Variant) As Boolean
 447 &apos;  Return True if property setting OK
 448 Dim cstThisSub As String
 449         cstThisSub = Utils._PCase(_Type) &amp; &quot;.getProperty&quot;
 450         Utils._SetCalledSub(cstThisSub)
 451         setProperty = _PropertySet(psProperty, pvValue)
 452         Utils._ResetCalledSub(cstThisSub)
 453 End Function
 454
 455 REM -----------------------------------------------------------------------------------------------------------------------
 456 REM --- PRIVATE FUNCTIONS                                                                                                                                                                                       ---
 457 REM -----------------------------------------------------------------------------------------------------------------------
 458
 459 REM -----------------------------------------------------------------------------------------------------------------------
 460 Private Function _PropertiesList() As Variant
 461
 462         Select Case _Type
 463                 Case OBJTABLEDEF
 464                         _PropertiesList = Array(&quot;Name&quot;, &quot;ObjectType&quot;)
 465                 Case OBJQUERYDEF
 466                         _PropertiesList = Array(&quot;Name&quot;, &quot;ObjectType&quot;, &quot;SQL&quot;, &quot;Type&quot;)
 467                 Case Else
 468         End Select
 469
 470 End Function    &apos;  _PropertiesList
 471
 472 REM -----------------------------------------------------------------------------------------------------------------------
 473 Private Function _PropertyGet(ByVal psProperty As String) As Variant
 474 &apos;  Return property value of the psProperty property name
 475
 476         If _ErrorHandler() Then On Local Error Goto Error_Function
 477 Dim cstThisSub As String
 478         cstThisSub = Utils._PCase(_Type)
 479         Utils._SetCalledSub(cstThisSub &amp; &quot;.get&quot; &amp; psProperty)
 480 Dim vEMPTY As Variant, sSql As String, sVerb As String, iType As Integer
 481         _PropertyGet = vEMPTY
 482         If Not hasProperty(psProperty) Then Goto Trace_Error
 483
 484         Select Case UCase(psProperty)
 485                 Case UCase(&quot;Name&quot;)
 486                         _PropertyGet = _Name
 487                 Case UCase(&quot;ObjectType&quot;)
 488                         _PropertyGet = _Type
 489                 Case UCase(&quot;SQL&quot;)
 490                         _PropertyGet = Query.Command
 491                 Case UCase(&quot;Type&quot;)
 492                         iType = 0
 493                         sSql = Trim(UCase(Query.Command))
 494                         sVerb = Split(sSql, &quot; &quot;)(0)
 495                         If sVerb = &quot;SELECT&quot; Then iType = iType + dbQSelect
 496                         If sVerb = &quot;SELECT&quot; And InStr(sSql, &quot; INTO &quot;) &gt; 0 Then iType = iType + dbQMakeTable
 497                         If sVerb = &quot;SELECT&quot; And InStr(sSql, &quot; UNION &quot;) &gt; 0 Then iType = iType + dbQSetOperation
 498                         If Not Query.EscapeProcessing Then iType = iType + dbQSQLPassThrough
 499                         If sVerb = &quot;INSERT&quot; Then iType = iType + dbQAppend
 500                         If sVerb = &quot;DELETE&quot; Then iType = iType + dbQDelete
 501                         If sVerb = &quot;UPDATE&quot; Then iType = iType + dbQUpdate
 502                         If sVerb = &quot;CREATE&quot; _
 503                                 Or sVerb = &quot;ALTER&quot; _
 504                                 Or sVerb = &quot;DROP&quot; _
 505                                 Or sVerb = &quot;RENAME&quot; _
 506                                 Or sVerb = &quot;TRUNCATE&quot; _
 507                                         Then iType = iType + dbQDDL
 508                         &apos; dbQAction implied by dbQMakeTable, dbQAppend, dbQDelete and dbQUpdate
 509                         &apos; To check Type use: If (iType And dbQxxx) &lt;&gt; 0 Then ...
 510                         _PropertyGet = iType
 511                 Case Else
 512                         Goto Trace_Error
 513         End Select
 514
 515 Exit_Function:
 516         Utils._ResetCalledSub(cstThisSub &amp; &quot;.get&quot; &amp; psProperty)
 517         Exit Function
 518 Trace_Error:
 519         TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
 520         _PropertyGet = vEMPTY
 521         Goto Exit_Function
 522 Error_Function:
 523         TraceError(TRACEABORT, Err, cstThisSub &amp; &quot;._PropertyGet&quot;, Erl)
 524         _PropertyGet = vEMPTY
 525         GoTo Exit_Function
 526 End Function            &apos;  _PropertyGet
 527
 528 REM -----------------------------------------------------------------------------------------------------------------------
 529 Private Function _PropertySet(ByVal psProperty As String, ByVal pvValue As Variant) As Boolean
 530 &apos;  Return True if property setting OK
 531
 532         If _ErrorHandler() Then On Local Error Goto Error_Function
 533 Dim cstThisSub As String
 534         cstThisSub = Utils._PCase(_Type)
 535         Utils._SetCalledSub(cstThisSub &amp; &quot;.set&quot; &amp; psProperty)
 536
 537 &apos;Execute
 538 Dim iArgNr As Integer
 539
 540         _PropertySet = True
 541         Select Case UCase(_A2B_.CalledSub)
 542                 Case UCase(&quot;setProperty&quot;)                                             :       iArgNr = 3
 543                 Case UCase(cstThisSub &amp; &quot;.setProperty&quot;)                   :       iArgNr = 2
 544                 Case UCase(cstThisSub &amp; &quot;.set&quot; &amp; psProperty)  :       iArgNr = 1
 545         End Select
 546
 547         If Not hasProperty(psProperty) Then Goto Trace_Error
 548
 549         If _ReadOnly Then Goto Error_NoUpdate
 550
 551         Select Case UCase(psProperty)
 552                 Case UCase(&quot;SQL&quot;)
 553                         If Not Utils._CheckArgument(pvValue, iArgNr, vbString, , False) Then Goto Trace_Error_Value
 554                         Query.Command = pvValue
 555                 Case Else
 556                         Goto Trace_Error
 557         End Select
 558
 559 Exit_Function:
 560         Utils._ResetCalledSub(cstThisSub &amp; &quot;.set&quot; &amp; psProperty)
 561         Exit Function
 562 Trace_Error:
 563         TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
 564         _PropertySet = False
 565         Goto Exit_Function
 566 Trace_Error_Value:
 567         TraceError(TRACEFATAL, ERRPROPERTYVALUE, Utils._CalledSub(), 0, 1, Array(pvValue, psProperty))
 568         _PropertySet = False
 569         Goto Exit_Function
 570 Error_NoUpdate:
 571         TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0)
 572         Goto Exit_Function
 573 Error_Function:
 574         TraceError(TRACEABORT, Err, cstThisSub &amp; &quot;._PropertySet&quot;, Erl)
 575         _PropertySet = False
 576         GoTo Exit_Function
 577 End Function                    &apos;  _PropertySet
 578 </script:module>