forked from amazingfate/loongoffice
0bb042d442
+ workaround for setPosSize issue (LO 4.1) + "Sidebar" argument for RunCommand + Trace dialog layout revisit for cleaner display in Linux Change-Id: I0d5c4da5681ab1649d062a7133d507163163343e Reviewed-on: https://gerrit.libreoffice.org/6449 Reviewed-by: Lionel Elie Mamane <lionel@mamane.lu> Tested-by: Lionel Elie Mamane <lionel@mamane.lu>
528 lines
20 KiB
XML
528 lines
20 KiB
XML
<?xml version="1.0" encoding="UTF-8"?>
|
|
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
|
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Database" script:language="StarBasic">REM =======================================================================================================================
|
|
REM === The Access2Base library is a part of the LibreOffice project. ===
|
|
REM === Full documentation is available on http://www.access2base.com ===
|
|
REM =======================================================================================================================
|
|
|
|
Option Compatible
|
|
Option ClassModule
|
|
|
|
Option Explicit
|
|
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
REM --- CLASS ROOT FIELDS ---
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
|
|
Private _Type As String ' Must be DATABASE
|
|
Private _Standalone As Boolean
|
|
Private Title As String
|
|
Private Document As Object ' com.sun.star.comp.dba.ODatabaseDocument or SwXTextDocument
|
|
Private Connection As Object ' com.sun.star.sdbc.drivers.OConnectionWrapper
|
|
Private URL As String
|
|
Private MetaData As Object ' interface XDatabaseMetaData
|
|
Private Form As Object ' com.sun.star.form.XForm
|
|
Private FormName As String ' name of standalone form
|
|
Private FindRecord As Object
|
|
Private StatusBar As Object
|
|
Private Dialogs As Object ' Collection
|
|
Private RecordsetMax As Integer
|
|
Private RecordsetsColl As Object ' Collection of active recordsets
|
|
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
REM --- CONSTRUCTORS / DESTRUCTORS ---
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
Private Sub Class_Initialize()
|
|
_Type = OBJDATABASE
|
|
_Standalone = False
|
|
Title = ""
|
|
Set Document = Nothing
|
|
Set Connection = Nothing
|
|
URL = ""
|
|
Set MetaData = Nothing
|
|
Set Form = Nothing
|
|
FormName = ""
|
|
Set FindRecord = Nothing
|
|
Set StatusBar = Nothing
|
|
Set Dialogs = New Collection
|
|
RecordsetMax = 0
|
|
Set RecordsetsColl = New Collection
|
|
End Sub ' Constructor
|
|
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
'Private Sub Class_Terminate()
|
|
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
REM --- CLASS GET/LET/SET PROPERTIES ---
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
|
|
Property Get ObjectType() As String
|
|
ObjectType = _PropertyGet("ObjectType")
|
|
End Property ' ObjectType (get)
|
|
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
REM --- CLASS METHODS ---
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
Public Sub CloseAllRecordsets()
|
|
' Clean all recordsets for housekeeping
|
|
|
|
Dim sRecordsets() As String, i As Integer, oRecordset As Object
|
|
On Local Error Goto Exit_Sub
|
|
|
|
If IsNull(RecordsetsColl) Then Exit Sub
|
|
If RecordsetsColl.Count < 1 Then Exit Sub
|
|
For i = 1 To RecordsetsColl.Count
|
|
Set oRecordset = RecordsetsColl.Item(i)
|
|
oRecordset.mClose(False) ' Do not remove entry in collection
|
|
Next i
|
|
Set RecordsetsColl = New Collection
|
|
RecordsetMax = 0
|
|
|
|
Exit_Sub:
|
|
Exit Sub
|
|
End Sub ' CloseAllRecordsets V0.9.5
|
|
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
Public Function CreateQueryDef(ByVal Optional pvQueryName As Variant _
|
|
, ByVal Optional pvSql As Variant _
|
|
, ByVal Optional pvOption As Variant _
|
|
) As Object
|
|
'Return a (new) QueryDef object based on SQL statement
|
|
Const cstThisSub = "Database.CreateQueryDef"
|
|
Utils._SetCalledSub(cstThisSub)
|
|
|
|
Const cstNull = -1
|
|
Dim oQuery As Object, oQueries As Object
|
|
|
|
If _ErrorHandler() Then On Local Error Goto Error_Function
|
|
|
|
Set CreateQueryDef = Nothing
|
|
If _Standalone() Then Goto Error_Standalone
|
|
If IsMissing(pvQueryName) Then Call _TraceArguments()
|
|
If IsMissing(pvSql) Then Call _TraceArguments()
|
|
If IsMissing(pvOption) Then pvOption = cstNull
|
|
|
|
If Not Utils._CheckArgument(pvQueryName, 1, vbString) Then Goto Exit_Function
|
|
If pvQueryName = "" Then Call _TraceArguments()
|
|
If Not Utils._CheckArgument(pvSql, 2, vbString) Then Goto Exit_Function
|
|
If pvSql = "" Then Call _TraceArguments()
|
|
If Not Utils._CheckArgument(pvOption, 3, Utils._AddNumeric(), Array(cstNull, dbSQLPassThrough)) Then Goto Exit_Function
|
|
|
|
Set oQuery = CreateUnoService("com.sun.star.sdb.QueryDefinition")
|
|
oQuery.rename(pvQueryName)
|
|
oQuery.Command = Utils._ReplaceSquareBrackets(pvSql)
|
|
oQuery.EscapeProcessing = Not ( pvOption = dbSQLPassThrough )
|
|
|
|
Set oQueries = Document.DataSource.getQueryDefinitions()
|
|
With oQueries
|
|
If .hasByName(pvQueryName) Then
|
|
TraceError(TRACEWARNING, ERRQUERYDEFDELETED, Utils._CalledSub(), 0, False, pvQueryName)
|
|
.removeByName(pvQueryName)
|
|
End If
|
|
.insertByName(pvQueryName, oQuery)
|
|
End With
|
|
Set CreateQueryDef = QueryDefs(pvQueryName)
|
|
|
|
Exit_Function:
|
|
Utils._ResetCalledSub(cstThisSub)
|
|
Exit Function
|
|
Error_Standalone:
|
|
TraceError(TRACEFATAL, ERRSTANDALONE, Utils._CalledSub(), 0)
|
|
Goto Exit_Function
|
|
Error_Function:
|
|
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
|
GoTo Exit_Function
|
|
End Function ' CreateQueryDef V0.9.5
|
|
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
|
|
' Return property value of psProperty property name
|
|
|
|
Utils._SetCalledSub("Database.getProperty")
|
|
If IsMissing(pvProperty) Then Call _TraceArguments()
|
|
getProperty = _PropertyGet(pvProperty)
|
|
Utils._ResetCalledSub("Database.getProperty")
|
|
|
|
End Function ' getProperty
|
|
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
|
|
' Return True if object has a valid property called pvProperty (case-insensitive comparison !)
|
|
|
|
If IsMissing(pvProperty) Then hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList()) Else hasProperty = PropertiesGet._hasProperty(_Type, _PropertiesList(), pvProperty)
|
|
Exit Function
|
|
|
|
End Function ' hasProperty
|
|
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
Public Function OpenRecordset(ByVal Optional pvSource As Variant _
|
|
, ByVal Optional pvType As Variant _
|
|
, ByVal Optional pvOptions As Variant _
|
|
, ByVal Optional pvLockEdit As Variant _
|
|
) As Object
|
|
'Return a Recordset object based on Source (= SQL, table or query name)
|
|
|
|
Const cstThisSub = "Database.OpenRecordset"
|
|
Utils._SetCalledSub(cstThisSub)
|
|
Const cstNull = -1
|
|
|
|
Dim lCommandType As Long, sCommand As String, oObject As Object
|
|
Dim sSource As String, i As Integer, iCount As Integer
|
|
Dim sObjects() As String, bFound As Boolean, oTables As Object, oQueries As Object
|
|
|
|
If _ErrorHandler() Then On Local Error Goto Error_Function
|
|
Set oObject = Nothing
|
|
If IsMissing(pvSource) Then Call _TraceArguments()
|
|
If pvSource = "" Then Call _TraceArguments()
|
|
If IsMissing(pvType) Then
|
|
pvType = cstNull
|
|
Else
|
|
If Not Utils._CheckArgument(pvType, 1, Utils._AddNumeric(), dbOpenForwardOnly) Then Goto Exit_Function
|
|
End If
|
|
If IsMissing(pvOptions) Then
|
|
pvOptions = cstNull
|
|
Else
|
|
If Not Utils._CheckArgument(pvOptions, 2, Utils._AddNumeric(), dbSQLPassThrough) Then Goto Exit_Function
|
|
End If
|
|
If IsMissing(pvLockEdit) Then
|
|
pvLockEdit = cstNull
|
|
Else
|
|
If Not Utils._CheckArgument(pvLockEdit, 3, Utils._AddNumeric(), dbReadOnly) Then Goto Exit_Function
|
|
End If
|
|
|
|
sSource = Split(UCase(Trim(pvSource)), " ")(0)
|
|
Select Case True
|
|
Case sSource = "SELECT"
|
|
lCommandType = com.sun.star.sdb.CommandType.COMMAND
|
|
sCommand = Trim(Utils._ReplaceSquareBrackets(pvSource))
|
|
Case Else
|
|
sSource = UCase(Trim(pvSource))
|
|
REM Explore tables
|
|
Set oTables = Connection.getTables
|
|
sObjects = oTables.ElementNames()
|
|
bFound = False
|
|
For i = 0 To UBound(sObjects)
|
|
If sSource = UCase(sObjects(i)) Then
|
|
sCommand = sObjects(i)
|
|
bFound = True
|
|
Exit For
|
|
End If
|
|
Next i
|
|
If bFound Then
|
|
lCommandType = com.sun.star.sdb.CommandType.TABLE
|
|
Else
|
|
REM Explore queries
|
|
Set oQueries = Connection.getQueries
|
|
sObjects = oQueries.ElementNames()
|
|
For i = 0 To UBound(sObjects)
|
|
If sSource = UCase(sObjects(i)) Then
|
|
sCommand = sObjects(i)
|
|
bFound = True
|
|
Exit For
|
|
End If
|
|
Next i
|
|
If Not bFound Then Goto Trace_NotFound
|
|
lCommandType = com.sun.star.sdb.CommandType.QUERY
|
|
End If
|
|
End Select
|
|
|
|
Set oObject = New Recordset
|
|
With oObject
|
|
._CommandType = lCommandType
|
|
._Command = sCommand
|
|
._ParentName = Title
|
|
._ParentType = _Type
|
|
._ForwardOnly = ( pvType = dbOpenForwardOnly )
|
|
._PassThrough = ( pvOptions = dbSQLPassThrough )
|
|
._ReadOnly = ( pvLockEdit = dbReadOnly )
|
|
Call ._Initialize()
|
|
RecordsetMax = RecordsetMax + 1
|
|
._Name = Format(RecordsetMax, "0000000")
|
|
RecordsetsColl.Add(oObject, UCase(._Name))
|
|
End With
|
|
|
|
If Not ( oObject._BOF And oObject._EOF ) Then oObject.MoveFirst() ' Do nothing if resultset empty
|
|
|
|
Exit_Function:
|
|
Set OpenRecordset = oObject
|
|
Set oObject = Nothing
|
|
Utils._ResetCalledSub(cstThisSub)
|
|
Exit Function
|
|
Error_Function:
|
|
TraceError(TRACEABORT, Err, cstThisSub, Erl)
|
|
GoTo Exit_Function
|
|
Trace_NotFound:
|
|
TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array("Table/Query", pvSource))
|
|
Goto Exit_Function
|
|
End Function ' OpenRecordset V0.9.5
|
|
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
|
|
' Return
|
|
' a Collection object if pvIndex absent
|
|
' a Property object otherwise
|
|
|
|
Utils._SetCalledSub("Database.Properties")
|
|
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
|
|
vPropertiesList = _PropertiesList()
|
|
sObject = Utils._PCase(_Type)
|
|
If IsMissing(pvIndex) Then
|
|
vProperty = PropertiesGet._Properties(sObject, "", vPropertiesList)
|
|
Else
|
|
vProperty = PropertiesGet._Properties(sObject, "", vPropertiesList, pvIndex)
|
|
vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
|
|
End If
|
|
|
|
Exit_Function:
|
|
Set Properties = vProperty
|
|
Utils._ResetCalledSub("Database.Properties")
|
|
Exit Function
|
|
End Function ' Properties
|
|
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
Public Function QueryDefs(ByVal Optional pvIndex As variant) As Object
|
|
' Collect all Queries in the database
|
|
' Check when standalone <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
|
|
|
|
If _ErrorHandler() Then On Local Error Goto Error_Function
|
|
Utils._SetCalledSub("Database.QueryDefs")
|
|
|
|
Set QueryDefs = Nothing
|
|
If Not IsMissing(pvIndex) Then
|
|
If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
|
|
End If
|
|
|
|
Dim sObjects() As String, sObjectName As String, oObject As Object
|
|
Dim i As Integer, bFound As Boolean, oQueries As Object
|
|
|
|
Set oQueries = Connection.getQueries
|
|
sObjects = oQueries.ElementNames()
|
|
Select Case True
|
|
Case IsMissing(pvIndex)
|
|
Set oObject = New Collect
|
|
oObject._CollType = COLLQUERYDEFS
|
|
oObject._ParentType = OBJDATABASE
|
|
oObject._ParentName = ""
|
|
oObject._Count = UBound(sObjects) + 1
|
|
Goto Exit_Function
|
|
Case VarType(pvIndex) = vbString
|
|
bFound = False
|
|
' Check existence of object and find its exact (case-sensitive) name
|
|
For i = 0 To UBound(sObjects)
|
|
If UCase(pvIndex) = UCase(sObjects(i)) Then
|
|
sObjectName = sObjects(i)
|
|
bFound = True
|
|
Exit For
|
|
End If
|
|
Next i
|
|
If Not bFound Then Goto Trace_NotFound
|
|
Case Else ' pvIndex is numeric
|
|
If pvIndex < 0 Or pvIndex > UBound(sObjects) Then Goto Trace_IndexError
|
|
sObjectName = sObjects(pvIndex)
|
|
End Select
|
|
|
|
Set oObject = New DataDef
|
|
oObject._Type = OBJQUERYDEF
|
|
oObject._Name = sObjectName
|
|
Set oObject.Query = oQueries.getByName(sObjectName)
|
|
|
|
Exit_Function:
|
|
Set QueryDefs = oObject
|
|
Set oObject = Nothing
|
|
Utils._ResetCalledSub("Database.QueryDefs")
|
|
Exit Function
|
|
Error_Function:
|
|
TraceError(TRACEABORT, Err, "Database.QueryDefs", Erl)
|
|
GoTo Exit_Function
|
|
Trace_NotFound:
|
|
TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array("Query", pvIndex))
|
|
Goto Exit_Function
|
|
Trace_IndexError:
|
|
TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0)
|
|
Goto Exit_Function
|
|
End Function ' QueryDefs V0.9.5
|
|
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
Public Function Recordsets(ByVal Optional pvIndex As variant) As Object
|
|
' Collect all active recordsets
|
|
|
|
If _ErrorHandler() Then On Local Error Goto Error_Function
|
|
Utils._SetCalledSub("Database.Recordsets")
|
|
|
|
Set Recordsets = Nothing
|
|
If Not IsMissing(pvIndex) Then
|
|
If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
|
|
End If
|
|
|
|
Dim sObjects() As String, sObjectName As String, oObject As Object
|
|
Dim i As Integer, bFound As Boolean, oTables As Object
|
|
|
|
Select Case True
|
|
Case IsMissing(pvIndex)
|
|
Set oObject = New Collect
|
|
oObject._CollType = COLLRECORDSETS
|
|
oObject._ParentType = OBJDATABASE
|
|
oObject._ParentName = ""
|
|
oObject._Count = RecordsetsColl.Count
|
|
Case VarType(pvIndex) = vbString
|
|
bFound = _hasRecordset(pvIndex)
|
|
If Not bFound Then Goto Trace_NotFound
|
|
Set oObject = RecordsetsColl.Item(pvIndex)
|
|
Case Else ' pvIndex is numeric
|
|
If pvIndex < 0 Or pvIndex >= RecordsetsColl.Count Then Goto Trace_IndexError
|
|
Set oObject = RecordsetsColl.Item(pvIndex + 1) ' Collection members are numbered 1 ... Count
|
|
End Select
|
|
|
|
Exit_Function:
|
|
Set Recordsets = oObject
|
|
Set oObject = Nothing
|
|
Utils._ResetCalledSub("Database.Recordsets")
|
|
Exit Function
|
|
Error_Function:
|
|
TraceError(TRACEABORT, Err, "Database.Recordsets", Erl)
|
|
GoTo Exit_Function
|
|
Trace_NotFound:
|
|
TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array("Recordset", pvIndex))
|
|
Goto Exit_Function
|
|
Trace_IndexError:
|
|
TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0)
|
|
Goto Exit_Function
|
|
End Function ' Recordsets V0.9.5
|
|
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
Public Function TableDefs(ByVal Optional pvIndex As variant) As Object
|
|
' Collect all tables in the database
|
|
' Check when standalone <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
|
|
|
|
If _ErrorHandler() Then On Local Error Goto Error_Function
|
|
Utils._SetCalledSub("Database.TableDefs")
|
|
|
|
Set TableDefs = Nothing
|
|
If Not IsMissing(pvIndex) Then
|
|
If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
|
|
End If
|
|
|
|
Dim sObjects() As String, sObjectName As String, oObject As Object
|
|
Dim i As Integer, bFound As Boolean, oTables As Object
|
|
|
|
Set oTables = Connection.getTables
|
|
sObjects = oTables.ElementNames()
|
|
Select Case True
|
|
Case IsMissing(pvIndex)
|
|
Set oObject = New Collect
|
|
oObject._CollType = COLLTABLEDEFS
|
|
oObject._ParentType = OBJDATABASE
|
|
oObject._ParentName = ""
|
|
oObject._Count = UBound(sObjects) + 1
|
|
Goto Exit_Function
|
|
Case VarType(pvIndex) = vbString
|
|
bFound = False
|
|
' Check existence of object and find its exact (case-sensitive) name
|
|
For i = 0 To UBound(sObjects)
|
|
If UCase(pvIndex) = UCase(sObjects(i)) Then
|
|
sObjectName = sObjects(i)
|
|
bFound = True
|
|
Exit For
|
|
End If
|
|
Next i
|
|
If Not bFound Then Goto Trace_NotFound
|
|
Case Else ' pvIndex is numeric
|
|
If pvIndex < 0 Or pvIndex > UBound(sObjects) Then Goto Trace_IndexError
|
|
sObjectName = sObjects(pvIndex)
|
|
End Select
|
|
|
|
Set oObject = New DataDef
|
|
oObject._Type = OBJTABLEDEF
|
|
oObject._Name = sObjectName
|
|
Set oObject.Table = oTables.getByName(sObjectName)
|
|
|
|
Exit_Function:
|
|
Set TableDefs = oObject
|
|
Set oObject = Nothing
|
|
Utils._ResetCalledSub("Database.TableDefs")
|
|
Exit Function
|
|
Error_Function:
|
|
TraceError(TRACEABORT, Err, "Database.TableDefs", Erl)
|
|
GoTo Exit_Function
|
|
Trace_NotFound:
|
|
TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array("Table", pvIndex))
|
|
Goto Exit_Function
|
|
Trace_IndexError:
|
|
TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0)
|
|
Goto Exit_Function
|
|
End Function ' TableDefs V0.9.5
|
|
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
REM --- PRIVATE FUNCTIONS ---
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
Public Function _hasDialog(ByVal psName As String) As Boolean
|
|
' Return True if psName if in the collection of started dialogs
|
|
|
|
Dim oDialog As Object
|
|
If _ErrorHandler() Then On Local Error Goto Error_Function
|
|
Set oDialog = Dialogs.Item(UCase(psName))
|
|
_hasDialog = True
|
|
|
|
Exit_Function:
|
|
Exit Function
|
|
Error_Function: ' Item by key aborted
|
|
_hasDialog = False
|
|
GoTo Exit_Function
|
|
End Function ' _hasDialog V0.9.1
|
|
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
Public Function _hasRecordset(ByVal psName As String) As Boolean
|
|
' Return True if psName if in the collection of Recordsets
|
|
|
|
Dim oRecordset As Object
|
|
If _ErrorHandler() Then On Local Error Goto Error_Function
|
|
Set oRecordset = RecordsetsColl.Item(psName)
|
|
_hasRecordset = True
|
|
|
|
Exit_Function:
|
|
Exit Function
|
|
Error_Function: ' Item by key aborted
|
|
_hasRecordset = False
|
|
GoTo Exit_Function
|
|
End Function ' _hasRecordset V0.9.5
|
|
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
Private Function _PropertiesList() As Variant
|
|
|
|
_PropertiesList = Array("ObjectType")
|
|
|
|
End Function ' _PropertiesList
|
|
|
|
REM -----------------------------------------------------------------------------------------------------------------------
|
|
Private Function _PropertyGet(ByVal psProperty As String) As Variant
|
|
' Return property value of the psProperty property name
|
|
|
|
If _ErrorHandler() Then On Local Error Goto Error_Function
|
|
Utils._SetCalledSub("Database.get" & psProperty)
|
|
Dim vEMPTY As Variant
|
|
_PropertyGet = vEMPTY
|
|
|
|
Select Case UCase(psProperty)
|
|
Case UCase("ObjectType")
|
|
_PropertyGet = _Type
|
|
Case Else
|
|
Goto Trace_Error
|
|
End Select
|
|
|
|
Exit_Function:
|
|
Utils._ResetCalledSub("Database.get" & psProperty)
|
|
Exit Function
|
|
Trace_Error:
|
|
TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
|
|
_PropertyGet = vEMPTY
|
|
Goto Exit_Function
|
|
Error_Function:
|
|
TraceError(TRACEABORT, Err, "Database._PropertyGet", Erl)
|
|
_PropertyGet = vEMPTY
|
|
GoTo Exit_Function
|
|
End Function ' _PropertyGet
|
|
</script:module> |