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