移除office-plugin, 使用新版jodconverter
This commit is contained in:
陈精华
399
server/windows-office/share/basic/Access2Base/Collect.xba
Normal file
399
server/windows-office/share/basic/Access2Base/Collect.xba
Normal file
@ -0,0 +1,399 @@
|
||||
<?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 <> COLLECTION (is a reserved name for ... collections)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS ROOT FIELDS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Private _Type As String ' Must be COLLECTION
|
||||
Private _This As Object ' 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 = ""
|
||||
Set _Parent = Nothing
|
||||
_Count = 0
|
||||
End Sub ' Constructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Sub Class_Terminate()
|
||||
On Local Error Resume Next
|
||||
Call Class_Initialize()
|
||||
End Sub ' Destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Sub Dispose()
|
||||
Call Class_Terminate()
|
||||
End Sub ' Explicit destructor
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS GET/LET/SET PROPERTIES ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Property Get Count() As Long
|
||||
Count = _PropertyGet("Count")
|
||||
End Property ' Count (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Function Item(ByVal Optional pvItem As Variant) As Variant
|
||||
'Return property value.
|
||||
'pvItem either numeric index or property name
|
||||
|
||||
Const cstThisSub = "Collection.getItem"
|
||||
|
||||
If _ErrorHandler() Then On Local Error Goto Error_Function
|
||||
|
||||
Utils._SetCalledSub(cstThisSub)
|
||||
If IsMissing(pvItem) Then Goto Exit_Function ' To allow object watching in Basic IDE, do not generate error
|
||||
Select Case _CollType
|
||||
Case COLLCOMMANDBARCONTROLS ' 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
|
||||
' 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("OBJECT"), _GetLabel("PARENT")))
|
||||
Set Item = Nothing
|
||||
GoTo Exit_Function
|
||||
End Function ' Item V1.1.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Property Get ObjectType() As String
|
||||
ObjectType = _PropertyGet("ObjectType")
|
||||
End Property ' ObjectType (get)
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Properties(ByVal Optional pvIndex As Variant) As Variant
|
||||
' Return
|
||||
' a Collection object if pvIndex absent
|
||||
' 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 ' Properties
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- CLASS METHODS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
Public Function Add(Optional pvNew As Variant, Optional pvValue As Variant) As Boolean
|
||||
' Append a new TableDef or TempVar object to the TableDefs/TempVars collections
|
||||
|
||||
Const cstThisSub = "Collection.Add"
|
||||
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 <> 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 = "" 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 ' Add V1.1.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function Delete(ByVal Optional pvName As Variant) As Boolean
|
||||
' Delete a TableDef or QueryDef object in the TableDefs/QueryDefs collections
|
||||
|
||||
Const cstThisSub = "Collection.Delete"
|
||||
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 = ""
|
||||
If Not Utils._CheckArgument(pvName, 1, vbString) Then Goto Exit_Function
|
||||
If pvName = "" Then Call _TraceArguments()
|
||||
|
||||
Select Case _CollType
|
||||
Case COLLTABLEDEFS, COLLQUERYDEFS
|
||||
If _A2B_.CurrentDocIndex() <> 0 Then Goto Error_NotApplicable
|
||||
Set odbDatabase = Application._CurrentDb()
|
||||
If odbDatabase._DbConnect <> 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 ' Delete V1.1.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function getProperty(Optional ByVal pvProperty As Variant) As Variant
|
||||
' Return property value of psProperty property name
|
||||
|
||||
Utils._SetCalledSub("Collection.getProperty")
|
||||
If IsMissing(pvProperty) Then Call _TraceArguments()
|
||||
getProperty = _PropertyGet(pvProperty)
|
||||
Utils._ResetCalledSub("Collection.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 Remove(ByVal Optional pvName As Variant) As Boolean
|
||||
' Remove a TempVar from the TempVars collection
|
||||
|
||||
Const cstThisSub = "Collection.Remove"
|
||||
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 = ""
|
||||
If Not Utils._CheckArgument(pvName, 1, vbString) Then Goto Exit_Function
|
||||
If pvName = "" 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 ' Remove V1.2.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Public Function RemoveAll() As Boolean
|
||||
' Remove the whole TempVars collection
|
||||
|
||||
Const cstThisSub = "Collection.Remove"
|
||||
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
|
||||
|
||||
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
|
||||
End Function ' RemoveAll V1.2.0
|
||||
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
REM --- PRIVATE FUNCTIONS ---
|
||||
REM -----------------------------------------------------------------------------------------------------------------------
|
||||
Private Function _PropertiesList() As Variant
|
||||
_PropertiesList = Array("Count", "Item", "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("Collection.get" & psProperty)
|
||||
_PropertyGet = Nothing
|
||||
|
||||
Select Case UCase(psProperty)
|
||||
Case UCase("Count")
|
||||
_PropertyGet = _Count
|
||||
Case UCase("Item")
|
||||
Case UCase("ObjectType")
|
||||
_PropertyGet = _Type
|
||||
Case Else
|
||||
Goto Trace_Error
|
||||
End Select
|
||||
|
||||
Exit_Function:
|
||||
Utils._ResetCalledSub("Collection.get" & psProperty)
|
||||
Exit Function
|
||||
Trace_Error:
|
||||
TraceError(TRACEWARNING, ERRPROPERTY, Utils._CalledSub(), 0, , psProperty)
|
||||
_PropertyGet = Nothing
|
||||
Goto Exit_Function
|
||||
Error_Function:
|
||||
TraceError(TRACEABORT, Err, "Collection._PropertyGet", Erl)
|
||||
_PropertyGet = Nothing
|
||||
GoTo Exit_Function
|
||||
End Function ' _PropertyGet
|
||||
|
||||
</script:module>
|
||||
Reference in New Issue
Block a user