path: root/wizards/source/access2base/Database.xba

<?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				&apos;	Must be DATABASE
Private _This					As Object				&apos;	Workaround for absence of This builtin function
Private	_DbConnect				As Integer				&apos;	DBCONNECTxxx constants
Private	Title					As String
Private	Document				As Object				&apos;	com.sun.star.comp.dba.ODatabaseDocument	or SwXTextDocument or ScModelObj
Private	Connection				As Object				&apos;	com.sun.star.sdbc.drivers.OConnectionWrapper or com.sun.star.sdbc.XConnection
Private	URL						As String
Private _ReadOnly				As Boolean
Private	MetaData				As Object				&apos;	interface XDatabaseMetaData
Private	Form					As Object				&apos;	com.sun.star.form.XForm
Private FormName				As String
Private RecordsetMax			As Integer
Private	RecordsetsColl			As Object				&apos;	Collection of active recordsets

REM -----------------------------------------------------------------------------------------------------------------------
REM --- CONSTRUCTORS / DESTRUCTORS						        														---
REM -----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
	_Type = OBJDATABASE
	Set _This = Nothing
	_DbConnect = 0
	Title = &quot;&quot;
	Set Document = Nothing
	Set Connection = Nothing
	URL = &quot;&quot;
	_ReadOnly = False
	Set MetaData = Nothing
	Set Form = Nothing
	FormName = &quot;&quot;
	RecordsetMax = 0
	Set RecordsetsColl = New Collection
End Sub		&apos;	Constructor

REM -----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Terminate()
	On Local Error Resume Next
	Call CloseAllRecordsets()
	If _DbConnect &lt;&gt; DBCONNECTANY Then
		If Not IsNull(Connection) Then
			Connection.close()
			Connection.dispose()
			Set Connection = Nothing
		End If
	Else
		mClose()
	End If
	Call Class_Initialize()
End Sub		&apos;	Destructor

REM -----------------------------------------------------------------------------------------------------------------------
Public Sub Dispose()
	Call Class_Terminate()
End Sub		&apos;	Explicit destructor



REM -----------------------------------------------------------------------------------------------------------------------
REM --- CLASS GET/LET/SET PROPERTIES					        														---
REM -----------------------------------------------------------------------------------------------------------------------

Property Get ObjectType() As String
	ObjectType = _PropertyGet(&quot;ObjectType&quot;)
End Property		&apos;	ObjectType (get)

REM -----------------------------------------------------------------------------------------------------------------------
REM --- CLASS METHODS	 								        														---
REM -----------------------------------------------------------------------------------------------------------------------

REM -----------------------------------------------------------------------------------------------------------------------
Public Function mClose() As Variant
&apos;	Close the database

If _ErrorHandler() Then On Local Error Goto Error_Function
Const cstThisSub = &quot;Database.Close&quot;
	Utils._SetCalledSub(cstThisSub)
	mClose = False
	If _DbConnect &lt;&gt; DBCONNECTANY Then Goto Error_NotApplicable

	Connection.close()
	Connection.dispose()
	Set Connection = Nothing
	mClose = True

Exit_Function:
	Utils._ResetCalledSub(cstThisSub)
	Exit Function
Error_NotApplicable:
	TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
	Goto Exit_Function
Error_Function:
	TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
	GoTo Exit_Function
End Function		&apos;	(m)Close

REM -----------------------------------------------------------------------------------------------------------------------
Public Sub CloseAllRecordsets()
&apos;	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 &lt; 1 Then Exit Sub
	For i = 1 To RecordsetsColl.Count
		Set oRecordset = RecordsetsColl.Item(i)
		oRecordset.mClose(False)		&apos;	Do not remove entry in collection
	Next i
	Set RecordsetsColl = New Collection
	RecordsetMax = 0

Exit_Sub:
	Exit Sub
End Sub				&apos;	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
&apos;Return a (new) QueryDef object based on SQL statement
Const cstThisSub = &quot;Database.CreateQueryDef&quot;
	Utils._SetCalledSub(cstThisSub)

Const cstNull = -1
Dim oQuery As Object, oQueries As Object, i As Integer, sQueryName As String

	If _ErrorHandler() Then On Local Error Goto Error_Function

	Set CreateQueryDef = Nothing
	If _DbConnect &lt;&gt; DBCONNECTBASE Then Goto Error_NotApplicable
	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 = &quot;&quot; Then Call _TraceArguments()
	If Not Utils._CheckArgument(pvSql, 2, vbString) Then Goto Exit_Function
	If pvSql = &quot;&quot; Then Call _TraceArguments()
	If Not Utils._CheckArgument(pvOption, 3, Utils._AddNumeric(), Array(cstNull, dbSQLPassThrough)) Then Goto Exit_Function
	
	If _ReadOnly Then Goto Error_NoUpdate
	
	Set oQuery = CreateUnoService(&quot;com.sun.star.sdb.QueryDefinition&quot;)
	oQuery.rename(pvQueryName)
	oQuery.Command = _ReplaceSquareBrackets(pvSql)
	oQuery.EscapeProcessing = Not ( pvOption = dbSQLPassThrough )
	
	Set oQueries = Document.DataSource.getQueryDefinitions()
	With oQueries
		For i = 0 To .getCount() - 1
			sQueryName = .getByIndex(i).Name
			If UCase(sQueryName) = UCase(pvQueryName) Then
				TraceError(TRACEWARNING, ERRQUERYDEFDELETED, Utils._CalledSub(), 0, False, sQueryName)
				.removeByName(sQueryName)
				Exit For
			End If
		Next i
		.insertByName(pvQueryName, oQuery)
	End With
	Set CreateQueryDef = QueryDefs(pvQueryName)

Exit_Function:
	Utils._ResetCalledSub(cstThisSub)
	Exit Function
Error_NotApplicable:
	TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
	Goto Exit_Function
Error_NoUpdate:
	TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0)
	Goto Exit_Function
Error_Function:
	TraceError(TRACEABORT, Err, cstThisSub, Erl)
	GoTo Exit_Function
End Function	&apos;	CreateQueryDef	V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function CreateTableDef(ByVal Optional pvTableName As Variant) As Object
&apos;Return a (new/empty) TableDef object
Const cstThisSub = &quot;Database.CreateTableDef&quot;
	Utils._SetCalledSub(cstThisSub)

Dim oTable As Object, oTables As Object, sTables() As String
Dim i As Integer, sTableName As String, oNewTable As Object

	If _ErrorHandler() Then On Local Error Goto Error_Function

	Set CreateTableDef = Nothing
	If _DbConnect &lt;&gt; DBCONNECTBASE Then Goto Error_NotApplicable
	If IsMissing(pvTableName) Then Call _TraceArguments()

	If Not Utils._CheckArgument(pvTableName, 1, vbString) Then Goto Exit_Function
	If pvTableName = &quot;&quot; Then Call _TraceArguments()
	
	If _ReadOnly Then Goto Error_NoUpdate
	
	Set oTables = Connection.getTables
	With oTables
		sTables = .ElementNames()
		&apos;	Check existence of object and find its exact (case-sensitive) name
		For i = 0 To UBound(sTables)
			If UCase(pvTableName) = UCase(sTables(i)) Then
				sTableName = sTables(i)
				TraceError(TRACEWARNING, ERRTABLEDEFDELETED, Utils._CalledSub(), 0, False, sTableName)
				.dropByName(sTableName)
				Exit For
			End If
		Next i
		Set oNewTable = New DataDef
		oNewTable._Type = OBJTABLEDEF
		oNewTable._Name = pvTableName
		Set oNewTable._ParentDatabase = _This
		Set oNewTable.TableDescriptor = .createDataDescriptor()
		oNewTable.TableDescriptor.Name = pvTableName
	End With

	Set CreateTabledef = oNewTable

Exit_Function:
	Utils._ResetCalledSub(cstThisSub)
	Exit Function
Error_NotApplicable:
	TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
	Goto Exit_Function
Error_NoUpdate:
	TraceError(TRACEFATAL, ERRNOTUPDATABLE, Utils._CalledSub(), 0)
	Goto Exit_Function
Error_Function:
	TraceError(TRACEABORT, Err, cstThisSub, Erl)
	GoTo Exit_Function
End Function	&apos;	CreateTableDef	V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function DAvg( _
					ByVal Optional psExpr As String _
					, ByVal Optional psDomain As String _
					, ByVal Optional pvCriteria As Variant _
					) As Variant
&apos;	Return average of scope
Const cstThisSub = &quot;Database.DAvg&quot;
	Utils._SetCalledSub(cstThisSub)
	If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
	DAvg = _DFunction(&quot;AVG&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
	Utils._ResetCalledSub(cstThisSub)
End Function	&apos;	DAvg

REM -----------------------------------------------------------------------------------------------------------------------
Public Function DCount( _
					ByVal Optional psExpr As String _
					, ByVal Optional psDomain As String _
					, ByVal Optional pvCriteria As Variant _
					) As Variant
&apos;	Return # of occurrences of scope
Const cstThisSub = &quot;Database.DCount&quot;
	Utils._SetCalledSub(cstThisSub)
	If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
	DCount = _DFunction(&quot;COUNT&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
	Utils._ResetCalledSub(cstThisSub)
End Function	&apos;	DCount

REM -----------------------------------------------------------------------------------------------------------------------
Public Function DLookup( _
					ByVal Optional psExpr As String _
					, ByVal Optional psDomain As String _
					, ByVal Optional pvCriteria As Variant _
					, ByVal Optional pvOrderClause As Variant _
					) As Variant

&apos;	Return a value within a table
    &apos;Arguments: psExpr:			an SQL expression
    &apos;			psDomain:		a table- or queryname
    &apos;			pvCriteria:		an optional WHERE clause
    &apos;			pcOrderClause:	an optional order clause incl. &quot;DESC&quot; if relevant
    &apos;Return:    Value of the psExpr if found, else Null.
    &apos;Author:    inspired from Allen Browne. http://allenbrowne.com/ser-42.html
    &apos;Examples:
    &apos;           1. To find the last value, include DESC in the OrderClause, e.g.:
    &apos;               DLookup(&quot;[Surname] &amp; [FirstName]&quot;, &quot;tblClient&quot;, , &quot;ClientID DESC&quot;)
    &apos;           2. To find the lowest non-null value of a field, use the Criteria, e.g.:
    &apos;               DLookup(&quot;ClientID&quot;, &quot;tblClient&quot;, &quot;Surname Is Not Null&quot; , &quot;Surname&quot;)

Const cstThisSub = &quot;Database.DLookup&quot;
	Utils._SetCalledSub(cstThisSub)
	If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
	DLookup = _DFunction(&quot;&quot;, psExpr, psDomain _
					, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria) _
					, Iif(IsMissing(pvOrderClause), &quot;&quot;, pvOrderClause) _
					)
	Utils._ResetCalledSub(cstThisSub)
End Function	&apos;	DLookup

REM -----------------------------------------------------------------------------------------------------------------------
Public Function DMax( _
					ByVal Optional psExpr As String _
					, ByVal Optional psDomain As String _
					, ByVal Optional pvCriteria As Variant _
					) As Variant
&apos;	Return maximum of scope
Const cstThisSub = &quot;Database.DMax&quot;
	Utils._SetCalledSub(cstThisSub)
	If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
	DMax = _DFunction(&quot;MAX&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
	Utils._ResetCalledSub(cstThisSub)
End Function	&apos;	DMax

REM -----------------------------------------------------------------------------------------------------------------------
Public Function DMin( _
					ByVal Optional psExpr As String _
					, ByVal Optional psDomain As String _
					, ByVal Optional pvCriteria As Variant _
					) As Variant
&apos;	Return minimum of scope
Const cstThisSub = &quot;Database.DMin&quot;
	Utils._SetCalledSub(cstThisSub)
	If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
	DMin = _DFunction(&quot;MIN&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
	Utils._ResetCalledSub(cstThisSub)
End Function	&apos;	DMin

REM -----------------------------------------------------------------------------------------------------------------------
Public Function DStDev( _
					ByVal Optional psExpr As String _
					, ByVal Optional psDomain As String _
					, ByVal Optional pvCriteria As Variant _
					) As Variant
&apos;	Return standard deviation of scope
Const cstThisSub = &quot;Database.DStDev&quot;
	Utils._SetCalledSub(cstThisSub)
	If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
	DStDev = _DFunction(&quot;STDDEV_SAMP&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)	&apos;	STDDEV not STDEV !
	Utils._ResetCalledSub(cstThisSub)
End Function	&apos;	DStDev

REM -----------------------------------------------------------------------------------------------------------------------
Public Function DStDevP( _
					ByVal Optional psExpr As String _
					, ByVal Optional psDomain As String _
					, ByVal Optional pvCriteria As Variant _
					) As Variant
&apos;	Return standard deviation of scope
Const cstThisSub = &quot;Database.DStDevP&quot;
	Utils._SetCalledSub(cstThisSub)
	If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
	DStDevP = _DFunction(&quot;STDDEV_POP&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)	&apos;	STDDEV not STDEV !
	Utils._ResetCalledSub(cstThisSub)
End Function	&apos;	DStDevP

REM -----------------------------------------------------------------------------------------------------------------------
Public Function DSum( _
					ByVal Optional psExpr As String _
					, ByVal Optional psDomain As String _
					, ByVal Optional pvCriteria As Variant _
					) As Variant
&apos;	Return sum of scope
Const cstThisSub = &quot;Database.DSum&quot;
	Utils._SetCalledSub(cstThisSub)
	If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
	DSum = _DFunction(&quot;SUM&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
	Utils._ResetCalledSub(cstThisSub)
End Function	&apos;	DSum

REM -----------------------------------------------------------------------------------------------------------------------
Public Function DVar( _
					ByVal Optional psExpr As String _
					, ByVal Optional psDomain As String _
					, ByVal Optional pvCriteria As Variant _
					) As Variant
&apos;	Return variance of scope
Const cstThisSub = &quot;Database.DVar&quot;
	Utils._SetCalledSub(cstThisSub)
	If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
	DVar = _DFunction(&quot;VAR_SAMP&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
	Utils._ResetCalledSub(cstThisSub)
End Function	&apos;	DVar

REM -----------------------------------------------------------------------------------------------------------------------
Public Function DVarP( _
					ByVal Optional psExpr As String _
					, ByVal Optional psDomain As String _
					, ByVal Optional pvCriteria As Variant _
					) As Variant
&apos;	Return variance of scope
Const cstThisSub = &quot;Database.DVarP&quot;
	Utils._SetCalledSub(cstThisSub)
	If IsMissing(psExpr) Or IsMissing(psDomain) Then Call _TraceArguments()
	DVarP = _DFunction(&quot;VAR_POP&quot;, psExpr, psDomain, Iif(IsMissing(pvCriteria), &quot;&quot;, pvCriteria), &quot;&quot;)
	Utils._ResetCalledSub(cstThisSub)
End Function	&apos;	DVarP

REM -----------------------------------------------------------------------------------------------------------------------
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
&apos;	Return property value of psProperty property name

	Utils._SetCalledSub(&quot;Database.getProperty&quot;)
	If IsMissing(pvProperty) Then Call _TraceArguments()
	getProperty = _PropertyGet(pvProperty)
	Utils._ResetCalledSub(&quot;Database.getProperty&quot;)
	
End Function		&apos;	getProperty

REM -----------------------------------------------------------------------------------------------------------------------
Public Function hasProperty(ByVal Optional pvProperty As Variant) As Boolean
&apos;	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	&apos;	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
&apos;Return a Recordset object based on Source (= SQL, table or query name)

Const cstThisSub = &quot;Database.OpenRecordset&quot;
	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 = &quot;&quot; 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)), &quot; &quot;)(0)
	Select Case True
		Case sSource = &quot;SELECT&quot;
			lCommandType = com.sun.star.sdb.CommandType.COMMAND
			sCommand = _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) Or _ReadOnly )
		Set ._ParentDatabase = _This
		Call ._Initialize()
		RecordsetMax = RecordsetMax + 1
		._Name = Format(RecordsetMax, &quot;0000000&quot;)
		RecordsetsColl.Add(oObject, UCase(._Name))
	End With

	If Not ( oObject._BOF And oObject._EOF ) Then oObject.MoveFirst()		&apos;	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(_GetLabel(&quot;TABLE&quot;) &amp; &quot;/&quot; &amp; _GetLabel(&quot;QUERY&quot;), pvSource))
	Goto Exit_Function
End Function	&apos;	OpenRecordset	V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function OpenSQL(Optional ByVal pvSQL As Variant _
						, Optional ByVal pvOption As Variant _
						) As Boolean
&apos;	Return True if the execution of the SQL statement was successful
&apos;	SQL must contain a SELECT query
&apos;	pvOption can force pass through mode

	If _ErrorHandler() Then On Local Error Goto Error_Function

Const cstThisSub = &quot;Database.OpenSQL&quot;
	Utils._SetCalledSub(cstThisSub)
	
	OpenSQL = False
	If IsMissing(pvSQL) Then Call _TraceArguments()
	If Not Utils._CheckArgument(pvSQL, 1, vbString) Then Goto Exit_Function
Const cstNull = -1
	If IsMissing(pvOption) Then
		pvOption = cstNull
	Else
		If Not Utils._CheckArgument(pvOption, 2, Utils._AddNumeric(), dbSQLPassThrough) Then Goto Exit_Function
	End If
	If _DbConnect &lt;&gt; DBCONNECTBASE And _DbConnect &lt;&gt; DBCONNECTFORM Then Goto Error_NotApplicable

Dim oURL As New com.sun.star.util.URL, oDispatch As Object
Dim vArgs(8) as New com.sun.star.beans.PropertyValue

	oURL.Complete = &quot;.component:DB/DataSourceBrowser&quot;
	oDispatch = StarDesktop.queryDispatch(oURL, &quot;_Blank&quot;, 8)

	vArgs(0).Name = &quot;ActiveConnection&quot;		:	vArgs(0).Value = Connection
	vArgs(1).Name = &quot;CommandType&quot;			:	vArgs(1).Value = com.sun.star.sdb.CommandType.COMMAND
	vArgs(2).Name = &quot;Command&quot;				:	vArgs(2).Value = _ReplaceSquareBrackets(pvSQL)
	vArgs(3).Name = &quot;ShowMenu&quot;				:	vArgs(3).Value = True
	vArgs(4).Name = &quot;ShowTreeView&quot;			:	vArgs(4).Value = False
	vArgs(5).Name = &quot;ShowTreeViewButton&quot;	:	vArgs(5).Value = False
	vArgs(6).Name = &quot;Filter&quot;				:	vArgs(6).Value = &quot;&quot;
	vArgs(7).Name = &quot;ApplyFilter&quot;			:	vArgs(7).Value = False
	vArgs(8).Name = &quot;EscapeProcessing&quot;		:	vArgs(8).Value = CBool(Not ( pvOption = dbSQLPassThrough ))

	oDispatch.dispatch(oURL, vArgs)
	OpenSQL = True

Exit_Function:
	Exit Function
Error_Function:
	TraceError(TRACEABORT, Err, &quot;OpenSQL&quot;, Erl)
	GoTo Exit_Function
SQL_Error:
	TraceError(TRACEFATAL, ERRSQLSTATEMENT, Utils._CalledSub(), 0, , pvSQL)
	Goto Exit_Function
Error_NotApplicable:
	TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
	Goto Exit_Function
End Function		&apos;	OpenSQL		V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
&apos;	Return
&apos;		a Collection object if pvIndex absent
&apos;		a Property object otherwise

	Utils._SetCalledSub(&quot;Database.Properties&quot;)
Dim vProperty As Variant, vPropertiesList() As Variant, sObject As String
	vPropertiesList = _PropertiesList()
	sObject = Utils._PCase(_Type)
	If IsMissing(pvIndex) Then
		vProperty = PropertiesGet._Properties(sObject, &quot;&quot;, vPropertiesList)
	Else
		vProperty = PropertiesGet._Properties(sObject, &quot;&quot;, vPropertiesList, pvIndex)
		vProperty._Value = _PropertyGet(vPropertiesList(pvIndex))
	End If
	Set vProperty._ParentDatabase = _This
	
Exit_Function:
	Set Properties = vProperty
	Utils._ResetCalledSub(&quot;Database.Properties&quot;)
	Exit Function
End Function	&apos;	Properties

REM -----------------------------------------------------------------------------------------------------------------------
Public Function QueryDefs(ByVal Optional pvIndex As Variant, ByVal Optional pbCheck As Boolean) As Object
&apos;	Collect all Queries in the database
&apos;	pbCheck unpublished

	If _ErrorHandler() Then On Local Error Goto Error_Function
	Utils._SetCalledSub(&quot;Database.QueryDefs&quot;)
	If IsMissing(pbCheck) Then pbCheck = False

Dim sObjects() As String, sObjectName As String, oObject As Object
Dim i As Integer, bFound As Boolean, oQueries As Object
	Set oObject = Nothing
	If Not IsMissing(pvIndex) Then
		If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
	End If
			
	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 = &quot;&quot;
			Set oObject._ParentDatabase = _This
			oObject._Count = UBound(sObjects) + 1
			Goto Exit_Function
		Case VarType(pvIndex) = vbString
			bFound = False
		&apos;	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		&apos;	pvIndex is numeric
			If pvIndex &lt; 0 Or pvIndex &gt; UBound(sObjects) Then Goto Trace_IndexError
			sObjectName = sObjects(pvIndex)
	End Select

	Set oObject = New DataDef
	oObject._Type = OBJQUERYDEF
	oObject._Name = sObjectName
	Set oObject._ParentDatabase = _This
	oObject._readOnly = _ReadOnly
	Set oObject.Query = oQueries.getByName(sObjectName)

Exit_Function:
	Set QueryDefs = oObject
	Set oObject = Nothing
	Utils._ResetCalledSub(&quot;Database.QueryDefs&quot;)
	Exit Function
Error_Function:
	TraceError(TRACEABORT, Err, &quot;Database.QueryDefs&quot;, Erl)
	GoTo Exit_Function
Trace_NotFound:
	If Not pbCheck Then TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(&quot;QUERY&quot;), pvIndex))
	Goto Exit_Function
Trace_IndexError:
	TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0)
	Goto Exit_Function
End Function		&apos;	QueryDefs	V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function Recordsets(ByVal Optional pvIndex As Variant) As Object
&apos;	Collect all active recordsets

	If _ErrorHandler() Then On Local Error Goto Error_Function
	Utils._SetCalledSub(&quot;Database.Recordsets&quot;)

	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 = &quot;&quot;
			Set oObject._ParentDatabase = _This
			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		&apos;	pvIndex is numeric
			If pvIndex &lt; 0 Or pvIndex &gt;= RecordsetsColl.Count Then Goto Trace_IndexError
			Set oObject = RecordsetsColl.Item(pvIndex + 1)		&apos;	Collection members are numbered 1 ... Count
	End Select

Exit_Function:
	Set Recordsets = oObject
	Set oObject = Nothing
	Utils._ResetCalledSub(&quot;Database.Recordsets&quot;)
	Exit Function
Error_Function:
	TraceError(TRACEABORT, Err, &quot;Database.Recordsets&quot;, Erl)
	GoTo Exit_Function
Trace_NotFound:
	TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(&quot;RECORDSET&quot;), pvIndex))
	Goto Exit_Function
Trace_IndexError:
	TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0)
	Goto Exit_Function
End Function		&apos;	Recordsets	V0.9.5

REM -----------------------------------------------------------------------------------------------------------------------
Public Function RunSQL(Optional ByVal pvSQL As Variant _
						, Optional ByVal pvOption As Variant _
						) As Boolean
&apos;	Return True if the execution of the SQL statement was successful
&apos;	SQL must contain an ACTION query

	If _ErrorHandler() Then On Local Error Goto Error_Function

	Utils._SetCalledSub(&quot;RunSQL&quot;)
	
	RunSQL = False
	If IsMissing(pvSQL) Then Call _TraceArguments()
	If Not Utils._CheckArgument(pvSQL, 1, vbString) Then Goto Exit_Function
Const cstNull = -1
	If IsMissing(pvOption) Then
		pvOption = cstNull
	Else
		If Not Utils._CheckArgument(pvOption, 2, Utils._AddNumeric(), Array(cstNull, dbSQLPassThrough)) Then Goto Exit_Function
	End If

Dim oStatement As Object, vResult As Variant
	Set oStatement = Connection.createStatement()
	oStatement.EscapeProcessing = Not ( pvOption = dbSQLPassThrough )
	On Local Error Goto SQL_Error
	vResult = oStatement.executeUpdate(_ReplaceSquareBrackets(pvSQL))
	On Local Error Goto Error_Function
	RunSQL = True

Exit_Function:
	Exit Function
Error_Function:
	TraceError(TRACEABORT, Err, &quot;RunSQL&quot;, Erl)
	GoTo Exit_Function
SQL_Error:
	TraceError(TRACEFATAL, ERRSQLSTATEMENT, Utils._CalledSub(), 0, , pvSQL)
	Goto Exit_Function
End Function		&apos;	RunSQL		V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function TableDefs(ByVal Optional pvIndex As Variant, ByVal Optional pbCheck As Boolean) As Object
&apos;	Collect all tables in the database
&apos;	pbCheck unpublished

	If _ErrorHandler() Then On Local Error Goto Error_Function
	Utils._SetCalledSub(&quot;Database.TableDefs&quot;)
	If IsMissing(pbCheck) Then pbCheck = False

Dim sObjects() As String, sObjectName As String, oObject As Object
Dim i As Integer, bFound As Boolean, oTables As Object
	Set oObject = Nothing
	If Not IsMissing(pvIndex) Then
		If Not Utils._CheckArgument(pvIndex, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
	End If
			
	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 = &quot;&quot;
			Set oObject._ParentDatabase = _This
			oObject._Count = UBound(sObjects) + 1
			Goto Exit_Function
		Case VarType(pvIndex) = vbString
			bFound = False
		&apos;	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		&apos;	pvIndex is numeric
			If pvIndex &lt; 0 Or pvIndex &gt; UBound(sObjects) Then Goto Trace_IndexError
			sObjectName = sObjects(pvIndex)
	End Select

	Set oObject = New DataDef
	oObject._Type = OBJTABLEDEF
	oObject._Name = sObjectName
	Set oObject._ParentDatabase = _This
	oObject._ReadOnly = _ReadOnly
	Set oObject.Table = oTables.getByName(sObjectName)

Exit_Function:
	Set TableDefs = oObject
	Set oObject = Nothing
	Utils._ResetCalledSub(&quot;Database.TableDefs&quot;)
	Exit Function
Error_Function:
	TraceError(TRACEABORT, Err, &quot;Database.TableDefs&quot;, Erl)
	GoTo Exit_Function
Trace_NotFound:
	If Not pbCheck Then TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(&quot;TABLE&quot;), pvIndex))
	Goto Exit_Function
Trace_IndexError:
	TraceError(TRACEFATAL, ERRCOLLECTION, Utils._CalledSub(), 0)
	Goto Exit_Function
End Function		&apos;	TableDefs	V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
REM --- PRIVATE FUNCTIONS 								        														---
REM -----------------------------------------------------------------------------------------------------------------------

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _DFunction(ByVal psFunction As String _
							, ByVal psExpr As String _
							, ByVal psDomain As String _
							, ByVal pvCriteria As Variant _
							, ByVal Optional pvOrderClause As Variant _
							) As Variant
    &apos;Arguments: psFunction		an optional aggregate function
    &apos;			psExpr:			an SQL expression [might contain an aggregate function]
    &apos;			psDomain:		a table- or queryname
    &apos;			pvCriteria:		an optional WHERE clause
    &apos;			pcOrderClause:	an optional order clause incl. &quot;DESC&quot; if relevant

If _ErrorHandler() Then On Local Error GoTo Error_Function

Dim oResult As Object			&apos;To retrieve the value to find.
Dim vResult As Variant			&apos;Return value for function.
Dim sSql As String				&apos;SQL statement.
Dim oStatement As Object		&apos;For CreateStatement method
Dim sExpr As String				&apos;For inclusion of aggregate function
Dim sTempField As String		&apos;Random temporary field in SQL expression

    vResult = Null

	If psFunction = &quot;&quot; Then sExpr = &quot;TOP 1 &quot; &amp; psExpr Else sExpr = UCase(psFunction) &amp; &quot;(&quot; &amp; psExpr &amp; &quot;)&quot;

	Randomize 2^14-1
	sTempField = &quot;TEMP&quot; &amp; Right(&quot;00000&quot; &amp; Int(100000 * Rnd), 5)
    sSql = &quot;SELECT &quot; &amp; sExpr &amp; &quot; AS [&quot; &amp; sTempField &amp; &quot;] FROM &quot; &amp; psDomain
    If pvCriteria &lt;&gt; &quot;&quot; Then
        sSql = sSql &amp; &quot; WHERE &quot; &amp; pvCriteria
    End If
    If pvOrderClause &lt;&gt; &quot;&quot; Then
        sSql = sSql &amp; &quot; ORDER BY &quot; &amp; pvOrderClause
    End If

    &apos;Lookup the value.
    Set oStatement = Connection.createStatement()
	With oStatement
		.ResultSetType = com.sun.star.sdbc.ResultSetType.FORWARD_ONLY
		.ResultSetConcurrency = com.sun.star.sdbc.ResultSetConcurrency.READ_ONLY
		.EscapeProcessing = False
	    sSql = _ReplaceSquareBrackets(sSql)		&apos;Substitute [] by quote string
		Set oResult = .executeQuery(sSql)
	    If Not IsNull(oResult) And Not IsEmpty(oResult) Then
   				If Not oResult.next() Then Goto Exit_Function
       		    vResult = Utils._getResultSetColumnValue(oResult, 1)
    	End If
   	End With

Exit_Function:
    &apos;Assign the returned value.
    _DFunction = vResult
    Set oResult = Nothing
    Set oStatement = Nothing
    Exit Function
Error_Function:
    TraceError(TRACEABORT, ERRDFUNCTION, _A2B_.CalledSub, 0, , sSQL)
    Goto Exit_Function
End Function		&apos;	DFunction		V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _hasRecordset(ByVal psName As String) As Boolean
&apos;	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:		&apos;	Item by key aborted
	_hasRecordset = False
	GoTo Exit_Function
End Function	&apos;	_hasRecordset	V0.9.5

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertiesList() As Variant

	_PropertiesList = Array(&quot;ObjectType&quot;)

End Function	&apos;	_PropertiesList

REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertyGet(ByVal psProperty As String) As Variant
&apos;	Return property value of the psProperty property name

	If _ErrorHandler() Then On Local Error Goto Error_Function
	Utils._SetCalledSub(&quot;Database.get&quot; &amp; psProperty)
Dim vEMPTY As Variant
	_PropertyGet = vEMPTY
	
	Select Case UCase(psProperty)
		Case UCase(&quot;ObjectType&quot;)
			_PropertyGet = _Type
		Case Else
			Goto Trace_Error
	End Select
	
Exit_Function:
	Utils._ResetCalledSub(&quot;Database.get&quot; &amp; psProperty)
	Exit Function
Trace_Error:
	TraceError(TRACEFATAL, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
	_PropertyGet = vEMPTY
	Goto Exit_Function
Error_Function:
	TraceError(TRACEABORT, Err, &quot;Database._PropertyGet&quot;, Erl)
	_PropertyGet = vEMPTY
	GoTo Exit_Function
End Function		&apos;	_PropertyGet

REM -----------------------------------------------------------------------------------------------------------------------
Public Function _ReplaceSquareBrackets(ByVal psSql As String) As String
&apos; Returns psSql after substitution of [] by quote character
&apos; [] square brackets in (single) quoted strings not affected

Dim sQuote As String		&apos;RDBMS specific quote character
Dim vSubStrings() As Variant, i As Integer
Const cstSingleQuote = &quot;&apos;&quot;
	
	sQuote = MetaData.IdentifierQuoteString
	If sQuote = &quot; &quot; Then		&apos;	IdentifierQuoteString returns a space &quot; &quot; if identifier quoting is not supported.
		_ReplaceSquareBrackets = Trim(psSql)
		Exit Function
	End If
	vSubStrings() = Split(psSql, cstSingleQuote)
	For i = 0 To UBound(vSubStrings)
		If (i Mod 2) = 0 Then		&apos;	Only even substrings are parsed for square brackets
			vSubStrings(i) = Join(Split(vSubStrings(i), &quot;[&quot;), sQuote)
			vSubStrings(i) = Join(Split(vSubStrings(i), &quot;]&quot;), sQuote)
		End If
	Next i
	
	_ReplaceSquareBrackets = Trim(Join(vSubStrings, cstSingleQuote))
	
End Function	&apos;	ReplaceSquareBrackets		V1.1.0
</script:module>