Gecko [ www.utparral.edu.mx ]

Name	Size	Permission
acConstants.xba	14.11 KB	-rw-r--r--
Application.xba	74.03 KB	-rw-r--r--
Collect.xba	15.02 KB	-rw-r--r--
CommandBarControl.xba	14.3 KB	-rw-r--r--
CommandBar.xba	14.93 KB	-rw-r--r--
Control.xba	117.95 KB	-rw-r--r--
Database.xba	78.09 KB	-rw-r--r--
DataDef.xba	23.76 KB	-rw-r--r--
Dialog.xba	32.42 KB	-rw-r--r--
dialog.xlb	398 B	-rw-r--r--
dlgFormat.xdl	1.64 KB	-rw-r--r--
dlgTrace.xdl	3.77 KB	-rw-r--r--
DoCmd.xba	115.65 KB	-rw-r--r--
Event.xba	21.71 KB	-rw-r--r--
Field.xba	38.54 KB	-rw-r--r--
Form.xba	48.02 KB	-rw-r--r--
L10N.xba	51.39 KB	-rw-r--r--
_License.xba	1.48 KB	-rw-r--r--
Methods.xba	11.58 KB	-rw-r--r--
Module.xba	29.72 KB	-rw-r--r--
OptionGroup.xba	12.76 KB	-rw-r--r--
PropertiesGet.xba	64.05 KB	-rw-r--r--
PropertiesSet.xba	36.19 KB	-rw-r--r--
Property.xba	6.63 KB	-rw-r--r--
Python.xba	27.26 KB	-rw-r--r--
Recordset.xba	44.9 KB	-rw-r--r--
Root_.xba	12.55 KB	-rw-r--r--
script.xlb	1.58 KB	-rw-r--r--
SubForm.xba	33.2 KB	-rw-r--r--
TempVar.xba	8.19 KB	-rw-r--r--
Test.xba	406 B	-rw-r--r--
Trace.xba	17.6 KB	-rw-r--r--
UtilProperty.xba	14.66 KB	-rw-r--r--
Utils.xba	53.9 KB	-rw-r--r--

Code Editor : Collect.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="Collect" 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 MODULE NAME &lt;&gt; COLLECTION (is a reserved name for ... collections)

REM -----------------------------------------------------------------------------------------------------------------------
REM --- CLASS ROOT FIELDS 								        														---
REM -----------------------------------------------------------------------------------------------------------------------

Private _Type			As String		&apos;	Must be COLLECTION
Private _This			As Object		&apos;	Workaround for absence of This builtin function
Private _CollType		As String
Private _Parent			As Object
Private _Count			As Long

REM -----------------------------------------------------------------------------------------------------------------------
REM --- CONSTRUCTORS / DESTRUCTORS						        														---
REM -----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()
	_Type = OBJCOLLECTION
	Set _This = Nothing
	_CollType = &quot;&quot;
	Set _Parent = Nothing
	_Count = 0
End Sub		&apos;	Constructor

REM -----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Terminate()
	On Local Error Resume Next
	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 Count() As Long
	Count = _PropertyGet(&quot;Count&quot;)
End Property		&apos;	Count (get)

REM -----------------------------------------------------------------------------------------------------------------------
Function Item(ByVal Optional pvItem As Variant) As Variant
&apos;Return property value.
&apos;pvItem either numeric index or property name

Const cstThisSub = &quot;Collection.getItem&quot;

If _ErrorHandler() Then On Local Error Goto Error_Function

Utils._SetCalledSub(cstThisSub)
	If IsMissing(pvItem) Then Goto Exit_Function	&apos;	To allow object watching in Basic IDE, do not generate error
	Select Case _CollType
		Case COLLCOMMANDBARCONTROLS					&apos;	Have no name
			If Not Utils._CheckArgument(pvItem, 1, Utils._AddNumeric()) Then Goto Exit_Function
		Case Else
			If Not Utils._CheckArgument(pvItem, 1, Utils._AddNumeric(vbString)) Then Goto Exit_Function
	End Select

Dim vNames() As Variant, oProperty As Object

Set Item = Nothing
	Select Case _CollType
		Case COLLALLDIALOGS
			Set Item = Application.AllDialogs(pvItem)
		Case COLLALLFORMS
			Set Item = Application.AllForms(pvItem)
		Case COLLALLMODULES
			Set Item = Application.AllModules(pvItem)
		Case COLLCOMMANDBARS
			Set Item = Application.CommandBars(pvItem)
		Case COLLCOMMANDBARCONTROLS
			If IsNull(_Parent) Then GoTo Error_Parent
			Set Item = _Parent.CommandBarControls(pvItem)
		Case COLLCONTROLS
			If IsNull(_Parent) Then GoTo Error_Parent
			Set Item = _Parent.Controls(pvItem)
		Case COLLFORMS
			Set Item = Application.Forms(pvItem)
		Case COLLFIELDS
			If IsNull(_Parent) Then GoTo Error_Parent
			Set Item = _Parent.Fields(pvItem)
		Case COLLPROPERTIES
			If IsNull(_Parent) Then GoTo Error_Parent
			Select Case _Parent._Type
				Case OBJCONTROL, OBJSUBFORM, OBJDATABASE, OBJDIALOG, OBJFIELD _
						, OBJFORM, OBJQUERYDEF, OBJRECORDSET, OBJTABLEDEF
					Set Item = _Parent.Properties(pvItem)
				Case OBJCOLLECTION, OBJEVENT, OBJOPTIONGROUP, OBJPROPERTY
					&apos; NOT SUPPORTED
			End Select
		Case COLLQUERYDEFS
			Set Item = _Parent.QueryDefs(pvItem)
		Case COLLRECORDSETS
			Set Item = _Parent.Recordsets(pvItem)
		Case COLLTABLEDEFS
			Set Item = _Parent.TableDefs(pvItem)
		Case COLLTEMPVARS
			Set Item = Application.TempVars(pvItem)
		Case Else
	End Select

Exit_Function:
	Utils._ResetCalledSub(cstThisSub)
	Exit Function
Error_Function:
	TraceError(TRACEABORT, Err, Utils._CalledSub(), Erl)
	Set Item = Nothing
	GoTo Exit_Function
Error_Parent:
	TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, True, Array(_GetLabel(&quot;OBJECT&quot;), _GetLabel(&quot;PARENT&quot;)))
	Set Item = Nothing
	GoTo Exit_Function
End Function		&apos;	Item V1.1.0

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

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

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

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

Public Function Add(Optional pvNew As Variant, Optional pvValue As Variant) As Boolean
&apos;	Append a new TableDef or TempVar object to the TableDefs/TempVars collections

Const cstThisSub = &quot;Collection.Add&quot;
	Utils._SetCalledSub(cstThisSub)
	If _ErrorHandler() Then On Local Error Goto Error_Function
	
Dim odbDatabase As Object, oConnection As Object, oTables As Object, oTable As Object
Dim vObject As Variant, oTempVar As Object
	Add = False
	If IsMissing(pvNew) Then Call _TraceArguments()

Select Case _CollType
		Case COLLTABLEDEFS
			If Not Utils._CheckArgument(pvNew, 1, vbObject) Then Goto Exit_Function
			Set vObject = pvNew
			With vObject
				Set odbDatabase = ._ParentDatabase
				If odbDatabase._DbConnect &lt;&gt; DBCONNECTBASE Then Goto Error_NotApplicable
				Set oConnection = odbDatabase.Connection
				If IsNull(.TableDescriptor) Or .TableFieldsCount = 0 Then Goto Error_Sequence
				Set oTables = oConnection.getTables()
				oTables.appendByDescriptor(.TableDescriptor)
				Set .Table = oTables.getByName(._Name)
				.CatalogName = .Table.CatalogName
				.SchemaName = .Table.SchemaName
				.TableName = .Table.Name
				.TableDescriptor.dispose()
				Set .TableDescriptor = Nothing
				.TableFieldsCount = 0
				.TableKeysCount = 0
			End With
		Case COLLTEMPVARS
			If Not Utils._CheckArgument(pvNew, 1, vbString) Then Goto Exit_Function
			If pvNew = &quot;&quot; Then Goto Error_Name
			If IsMissing(pvValue) Then Call _TraceArguments()
			If _A2B_.hasItem(COLLTEMPVARS, pvNew) Then Goto Error_Name
			Set oTempVar = New TempVar
			oTempVar._This = oTempVar
			oTempVar._Name = pvNew
			oTempVar._Value = pvValue
			_A2B_.TempVars.Add(oTempVar, UCase(pvNew))
		Case Else
			Goto Error_NotApplicable
	End Select

_Count = _Count + 1
	Add = True

Exit_Function:
	Utils._ResetCalledSub(cstThisSub)
	Exit Function
Error_Function:
	TraceError(TRACEABORT, Err, cstThisSub, Erl)
	GoTo Exit_Function
Error_NotApplicable:
	TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
	Goto Exit_Function
Error_Sequence:
	TraceError(TRACEFATAL, ERRTABLECREATION, Utils._CalledSub(), 0, 1, vObject._Name)
	Goto Exit_Function
Error_Name:
	TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), False, ,Array(1, pvNew))
	AddItem = False
	Goto Exit_Function
End Function		&apos;	Add	V1.1.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function Delete(ByVal Optional pvName As Variant) As Boolean
&apos;	Delete a TableDef or QueryDef object in the TableDefs/QueryDefs collections

Const cstThisSub = &quot;Collection.Delete&quot;
	Utils._SetCalledSub(cstThisSub)
	If _ErrorHandler() Then On Local Error Goto Error_Function
	
Dim odbDatabase As Object, oColl As Object, vName As Variant
	Delete = False
	If IsMissing(pvName) Then pvName = &quot;&quot;
	If Not Utils._CheckArgument(pvName, 1, vbString) Then Goto Exit_Function
	If pvName = &quot;&quot; Then Call _TraceArguments()

Select Case _CollType
		Case COLLTABLEDEFS, COLLQUERYDEFS
			If _A2B_.CurrentDocIndex() &lt;&gt; 0 Then Goto Error_NotApplicable 
			Set odbDatabase = Application._CurrentDb()
			If odbDatabase._DbConnect &lt;&gt; DBCONNECTBASE Then Goto Error_NotApplicable
			If _CollType = COLLTABLEDEFS Then Set oColl = odbDatabase.Connection.getTables() Else Set oColl = odbDatabase.Connection.getQueries()
			With oColl
				vName = _InList(pvName, .getElementNames(), True)
				If vName = False Then Goto trace_NotFound
				.dropByName(vName)
			End With
			odbDatabase.Document.store()
		Case Else
			Goto Error_NotApplicable
	End Select

_Count = _Count - 1
	Delete = True

Exit_Function:
	Utils._ResetCalledSub(cstThisSub)
	Exit Function
Error_Function:
	TraceError(TRACEABORT, Err, cstThisSub, Erl)
	GoTo Exit_Function
Error_NotApplicable:
	TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
	Goto Exit_Function
Trace_NotFound:
	TraceError(TRACEFATAL, ERROBJECTNOTFOUND, Utils._CalledSub(), 0, , Array(_GetLabel(Left(_CollType, 5)), pvName))
	Goto Exit_Function
End Function		&apos;	Delete	V1.1.0

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

Utils._SetCalledSub(&quot;Collection.getProperty&quot;)
	If IsMissing(pvProperty) Then Call _TraceArguments()
	getProperty = _PropertyGet(pvProperty)
	Utils._ResetCalledSub(&quot;Collection.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 Remove(ByVal Optional pvName As Variant) As Boolean
&apos;	Remove a TempVar from the TempVars collection

Const cstThisSub = &quot;Collection.Remove&quot;
	Utils._SetCalledSub(cstThisSub)
	If _ErrorHandler() Then On Local Error Goto Error_Function
	
Dim oColl As Object, vName As Variant
	Remove = False
	If IsMissing(pvName) Then pvName = &quot;&quot;
	If Not Utils._CheckArgument(pvName, 1, vbString) Then Goto Exit_Function
	If pvName = &quot;&quot; Then Call _TraceArguments()

Select Case _CollType
		Case COLLTEMPVARS
			If Not _A2B_.hasItem(COLLTEMPVARS, pvName) Then Goto Error_Name
			_A2B_.TempVars.Remove(UCase(pvName))
		Case Else
			Goto Error_NotApplicable
	End Select

_Count = _Count - 1
	Remove = True

Exit_Function:
	Utils._ResetCalledSub(cstThisSub)
	Exit Function
Error_Function:
	TraceError(TRACEABORT, Err, cstThisSub, Erl)
	GoTo Exit_Function
Error_NotApplicable:
	TraceError(TRACEFATAL, ERRMETHOD, Utils._CalledSub(), 0, 1, cstThisSub)
	Goto Exit_Function
Error_Name:
	TraceError(TRACEFATAL, ERRWRONGARGUMENT, Utils._CalledSub(), False, ,Array(1, pvName))
	AddItem = False
	Goto Exit_Function
End Function		&apos;	Remove	V1.2.0

REM -----------------------------------------------------------------------------------------------------------------------
Public Function RemoveAll() As Boolean
&apos;	Remove the whole TempVars collection

Const cstThisSub = &quot;Collection.Remove&quot;
	Utils._SetCalledSub(cstThisSub)
	If _ErrorHandler() Then On Local Error Goto Error_Function

Select Case _CollType
		Case COLLTEMPVARS
			Set _A2B_.TempVars = New Collection
			_Count = 0
		Case Else
			Goto Error_NotApplicable
	End Select

REM -----------------------------------------------------------------------------------------------------------------------
REM --- PRIVATE FUNCTIONS 								        														---
REM -----------------------------------------------------------------------------------------------------------------------
Private Function _PropertiesList() As Variant
	 _PropertiesList = Array(&quot;Count&quot;, &quot;Item&quot;, &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;Collection.get&quot; &amp; psProperty)
	_PropertyGet = Nothing
	
	Select Case UCase(psProperty)
		Case UCase(&quot;Count&quot;)
			_PropertyGet = _Count
		Case UCase(&quot;Item&quot;)
		Case UCase(&quot;ObjectType&quot;)
			_PropertyGet = _Type
		Case Else
			Goto Trace_Error
	End Select
	
Exit_Function:
	Utils._ResetCalledSub(&quot;Collection.get&quot; &amp; psProperty)
	Exit Function
Trace_Error:
	TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
	_PropertyGet = Nothing
	Goto Exit_Function
Error_Function:
	TraceError(TRACEABORT, Err, &quot;Collection._PropertyGet&quot;, Erl)
	_PropertyGet = Nothing
	GoTo Exit_Function
End Function		&apos;	_PropertyGet

</script:module>

${this.title}

Code Editor : Collect.xba