mirror of
https://gitee.com/kekingcn/file-online-preview.git
synced 2026-03-16 06:03:53 +08:00
移除office-plugin, 使用新版jodconverter
This commit is contained in:
陈精华
331
server/windows-office/share/basic/Access2Base/UtilProperty.xba
Normal file
331
server/windows-office/share/basic/Access2Base/UtilProperty.xba
Normal file
@@ -0,0 +1,331 @@
|
||||
<?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="UtilProperty" 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 =======================================================================================================================
|
||||
|
||||
'**********************************************************************
|
||||
' UtilProperty module
|
||||
'
|
||||
' Module of utilities to manipulate arrays of PropertyValue's.
|
||||
'**********************************************************************
|
||||
|
||||
'**********************************************************************
|
||||
' Copyright (c) 2003-2004 Danny Brewer
|
||||
' d29583@groovegarden.com
|
||||
'**********************************************************************
|
||||
|
||||
'**********************************************************************
|
||||
' If you make changes, please append to the change log below.
|
||||
'
|
||||
' Change Log
|
||||
' Danny Brewer Revised 2004-02-25-01
|
||||
' Jean-Pierre Ledure Adapted to Access2Base coding conventions
|
||||
' PropValuesToStr rewritten and addition of StrToPropValues
|
||||
' Bug corrected on date values
|
||||
' Addition of support of 2-dimensional arrays
|
||||
' Support of empty arrays to allow JSON conversions
|
||||
'**********************************************************************
|
||||
|
||||
Option Explicit
|
||||
|
||||
Private Const cstHEADER = "### PROPERTYVALUES ###"
|
||||
Private Const cstEMPTYARRAY = "### EMPTY ARRAY ###"
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _MakePropertyValue(ByVal Optional psName As String, Optional pvValue As Variant) As com.sun.star.beans.PropertyValue
|
||||
' Create and return a new com.sun.star.beans.PropertyValue.
|
||||
|
||||
Dim oPropertyValue As New com.sun.star.beans.PropertyValue
|
||||
|
||||
If Not IsMissing(psName) Then oPropertyValue.Name = psName
|
||||
If Not IsMissing(pvValue) Then oPropertyValue.Value = _CheckPropertyValue(pvValue)
|
||||
_MakePropertyValue() = oPropertyValue
|
||||
|
||||
End Function ' _MakePropertyValue V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _CheckPropertyValue(ByRef pvValue As Variant) As Variant
|
||||
' Date BASIC variables give error. Change them to strings
|
||||
' Empty arrays should be replaced by cstEMPTYARRAY
|
||||
|
||||
If VarType(pvValue) = vbDate Then
|
||||
_CheckPropertyValue = Utils._CStr(pvValue, False)
|
||||
ElseIf IsArray(pvValue) Then
|
||||
If UBound(pvValue, 1) < LBound(pvValue, 1) Then _CheckPropertyValue = cstEMPTYARRAY Else _CheckPropertyValue = pvValue
|
||||
Else
|
||||
_CheckPropertyValue = pvValue
|
||||
End If
|
||||
|
||||
End Function ' _CheckPropertyValue
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _NumPropertyValues(ByRef pvPropertyValuesArray As Variant) As Integer
|
||||
' Return the number of PropertyValue's in an array.
|
||||
' Parameters:
|
||||
' pvPropertyValuesArray - an array of PropertyValue's, that is an array of com.sun.star.beans.PropertyValue.
|
||||
' Returns zero if the array contains no elements.
|
||||
|
||||
Dim iNumProperties As Integer
|
||||
If Not IsArray(pvPropertyValuesArray) Then iNumProperties = 0 Else iNumProperties = UBound(pvPropertyValuesArray) + 1
|
||||
_NumPropertyValues() = iNumProperties
|
||||
|
||||
End Function ' _NumPropertyValues V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _FindPropertyIndex(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String ) As Integer
|
||||
' Find a particular named property from an array of PropertyValue's.
|
||||
' Finds the index in the array of PropertyValue's and returns it, or returns -1 if it was not found.
|
||||
|
||||
Dim iNumProperties As Integer, i As Integer, vProp As Variant
|
||||
iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
|
||||
For i = 0 To iNumProperties - 1
|
||||
vProp = pvPropertyValuesArray(i)
|
||||
If UCase(vProp.Name) = UCase(psPropName) Then
|
||||
_FindPropertyIndex() = i
|
||||
Exit Function
|
||||
EndIf
|
||||
Next i
|
||||
_FindPropertyIndex() = -1
|
||||
|
||||
End Function ' _FindPropertyIndex V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _FindProperty(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String) As com.sun.star.beans.PropertyValue
|
||||
' Find a particular named property from an array of PropertyValue's.
|
||||
' Finds the PropertyValue and returns it, or returns Null if not found.
|
||||
|
||||
Dim iPropIndex As Integer, vProp As Variant
|
||||
iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
|
||||
If iPropIndex >= 0 Then
|
||||
vProp = pvPropertyValuesArray(iPropIndex) ' access array subscript
|
||||
_FindProperty() = vProp
|
||||
EndIf
|
||||
|
||||
End Function ' _FindProperty V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _GetPropertyValue(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String, Optional pvDefaultValue) As Variant
|
||||
' Get the value of a particular named property from an array of PropertyValue's.
|
||||
' vDefaultValue - This value is returned if the property is not found in the array.
|
||||
|
||||
Dim iPropIndex As Integer, vProp As Variant, vValue As Variant, vMatrix As Variant, i As Integer, j As Integer
|
||||
iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
|
||||
If iPropIndex >= 0 Then
|
||||
vProp = pvPropertyValuesArray(iPropIndex) ' access array subscript
|
||||
vValue = vProp.Value ' get the value from the PropertyValue
|
||||
If VarType(vValue) = vbString Then
|
||||
If vValue = cstEMPTYARRAY Then _GetPropertyValue() = Array() Else _GetPropertyValue() = vValue
|
||||
ElseIf IsArray(vValue) Then
|
||||
If IsArray(vValue(0)) Then ' Array of arrays
|
||||
vMatrix = Array()
|
||||
ReDim vMatrix(0 To UBound(vValue), 0 To UBound(vValue(0)))
|
||||
For i = 0 To UBound(vValue)
|
||||
For j = 0 To UBound(vValue(0))
|
||||
vMatrix(i, j) = vValue(i)(j)
|
||||
Next j
|
||||
Next i
|
||||
_GetPropertyValue() = vMatrix
|
||||
Else
|
||||
_GetPropertyValue() = vValue ' Simple vector OK
|
||||
End If
|
||||
Else
|
||||
_GetPropertyValue() = vValue
|
||||
End If
|
||||
Else
|
||||
If IsMissing(pvDefaultValue) Then pvDefaultValue = Null
|
||||
_GetPropertyValue() = pvDefaultValue
|
||||
EndIf
|
||||
|
||||
End Function ' _GetPropertyValue V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Sub _SetPropertyValue(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String, ByVal pvValue As Variant)
|
||||
' Set the value of a particular named property from an array of PropertyValue's.
|
||||
|
||||
Dim iPropIndex As Integer, vProp As Variant, iNumProperties As Integer
|
||||
|
||||
iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
|
||||
If iPropIndex >= 0 Then
|
||||
' Found, the PropertyValue is already in the array. Just modify its value.
|
||||
vProp = pvPropertyValuesArray(iPropIndex) ' access array subscript
|
||||
vProp.Value = _CheckPropertyValue(pvValue) ' set the property value.
|
||||
pvPropertyValuesArray(iPropIndex) = vProp ' put it back into array
|
||||
Else
|
||||
' Not found, the array contains no PropertyValue with this name. Append new element to array.
|
||||
iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
|
||||
If iNumProperties = 0 Then
|
||||
pvPropertyValuesArray = Array(_MakePropertyValue(psPropName, pvValue))
|
||||
Else
|
||||
' Make array larger.
|
||||
Redim Preserve pvPropertyValuesArray(iNumProperties)
|
||||
' Assign new PropertyValue
|
||||
pvPropertyValuesArray(iNumProperties) = _MakePropertyValue(psPropName, pvValue)
|
||||
EndIf
|
||||
EndIf
|
||||
|
||||
End Sub ' _SetPropertyValue V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Sub _DeleteProperty(ByRef pvPropertyValuesArray As Variant, ByVal psPropName As String)
|
||||
' Delete a particular named property from an array of PropertyValue's.
|
||||
|
||||
Dim iPropIndex As Integer
|
||||
iPropIndex = _FindPropertyIndex(pvPropertyValuesArray, psPropName)
|
||||
If iPropIndex >= 0 Then _DeleteIndexedProperty(pvPropertyValuesArray, iPropIndex)
|
||||
|
||||
End Sub ' _DeletePropertyValue V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Sub _DeleteIndexedProperty(ByRef pvPropertyValuesArray As Variant, ByVal piPropIndex As Integer)
|
||||
' Delete a particular indexed property from an array of PropertyValue's.
|
||||
|
||||
Dim iNumProperties As Integer, i As Integer
|
||||
iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
|
||||
|
||||
' Did we find it?
|
||||
If piPropIndex < 0 Then
|
||||
' Do nothing
|
||||
ElseIf iNumProperties = 1 Then
|
||||
' Just return a new empty array
|
||||
pvPropertyValuesArray = Array()
|
||||
Else
|
||||
' If it is NOT the last item in the array, then shift other elements down into it's position.
|
||||
If piPropIndex < iNumProperties - 1 Then
|
||||
' Bump items down lower in the array.
|
||||
For i = piPropIndex To iNumProperties - 2
|
||||
pvPropertyValuesArray(i) = pvPropertyValuesArray(i + 1)
|
||||
Next i
|
||||
EndIf
|
||||
' Redimension the array to have one fewer element.
|
||||
Redim Preserve pvPropertyValuesArray(iNumProperties - 2)
|
||||
EndIf
|
||||
|
||||
End Sub ' _DeleteIndexedProperty V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _PropValuesToStr(ByRef pvPropertyValuesArray As Variant) As String
|
||||
' Return a string with dumped content of the array of PropertyValue's.
|
||||
' SYNTAX:
|
||||
' NameOfProperty = This is a string (or 12 or 2016-12-31 12:05 or 123.45 or -0.12E-05 ...)
|
||||
' NameOfArray = (10)
|
||||
' 1;2;3;4;5;6;7;8;9;10
|
||||
' NameOfMatrix = (2,10)
|
||||
' 1;2;3;4;5;6;7;8;9;10
|
||||
' A;B;C;D;E;F;G;H;I;J
|
||||
' Semicolons and backslashes are escaped with a backslash (see _CStr and _CVar functions)
|
||||
|
||||
Dim iNumProperties As Integer, sResult As String, i As Integer, j As Integer, vProp As Variant
|
||||
Dim sName As String, vValue As Variant, iType As Integer
|
||||
Dim cstLF As String
|
||||
|
||||
cstLF = vbLf()
|
||||
iNumProperties = _NumPropertyValues(pvPropertyValuesArray)
|
||||
|
||||
sResult = cstHEADER & cstLF
|
||||
For i = 0 To iNumProperties - 1
|
||||
vProp = pvPropertyValuesArray(i)
|
||||
sName = vProp.Name
|
||||
vValue = vProp.Value
|
||||
iType = VarType(vValue)
|
||||
Select Case iType
|
||||
Case < vbArray ' Scalar
|
||||
sResult = sResult & sName & " = " & Utils._CStr(vValue, False) & cstLF
|
||||
Case Else ' Vector or matrix
|
||||
If uBound(vValue, 1) < 0 Then
|
||||
sResult = sResult & sName & " = (0)" & cstLF
|
||||
' 1-dimension but vector of vectors must also be considered
|
||||
ElseIf VarType(vValue(0)) >= vbArray Then
|
||||
sResult = sResult & sName & " = (" & UBound(vValue) + 1 & "," & UBound(vValue(0)) + 1 & ")" & cstLF
|
||||
For j = 0 To UBound(vValue)
|
||||
sResult = sResult & Utils._CStr(vValue(j), False) & cstLF
|
||||
Next j
|
||||
Else
|
||||
sResult = sResult & sName & " = (" & UBound(vValue, 1) + 1 & ")" & cstLF
|
||||
sResult = sResult & Utils._CStr(vValue, False) & cstLF
|
||||
End If
|
||||
End Select
|
||||
Next i
|
||||
|
||||
_PropValuesToStr() = Left(sResult, Len(sResult) - 1) ' Remove last LF
|
||||
|
||||
End Function ' _PropValuesToStr V1.3.0
|
||||
|
||||
REM =======================================================================================================================
|
||||
Public Function _StrToPropValues(psString) As Variant
|
||||
' Return an array of PropertyValue's rebuilt from the string parameter
|
||||
|
||||
Dim vString() As Variant, i As Integer,iArray As Integer, iRows As Integer, iCols As Integer
|
||||
Dim lPosition As Long, sName As String, vValue As Variant, vResult As Variant, sDim As String
|
||||
Dim lSearch As Long
|
||||
Dim cstLF As String
|
||||
Const cstEqualArray = " = (", cstEqual = " = "
|
||||
|
||||
cstLF = Chr(10)
|
||||
_StrToPropValues = Array()
|
||||
vResult = Array()
|
||||
|
||||
If psString = "" Then Exit Function
|
||||
vString = Split(psString, cstLF)
|
||||
If UBound(vString) <= 0 Then Exit Function ' There must be at least one name-value pair
|
||||
If vString(0) <> cstHEADER Then Exit Function ' Check origin
|
||||
|
||||
iArray = -1
|
||||
For i = 1 To UBound(vString)
|
||||
If vString(i) <> "" Then ' Skip empty lines
|
||||
If iArray < 0 Then ' Not busy with array row
|
||||
lPosition = 1
|
||||
sName = Utils._RegexSearch(vString(i), "^\b\w+\b", lPosition) ' Identifier
|
||||
If sName = "" Then Exit Function
|
||||
If InStr(vString(i), cstEqualArray) = lPosition + Len(sName) Then ' Start array processing
|
||||
lSearch = lPosition + Len(sName) + Len(cstEqualArray) - 1
|
||||
sDim = Utils._RegexSearch(vString(i), "\([0-9]+\)", lSearch) ' e.g. (10)
|
||||
If sDim = "(0)" Then ' Empty array
|
||||
iRows = -1
|
||||
vValue = Array()
|
||||
_SetPropertyValue(vResult, sName, vValue)
|
||||
ElseIf sDim <> "" Then ' Vector with content
|
||||
iCols = CInt(Mid(sDim, 2, Len(sDim) - 2))
|
||||
iRows = 0
|
||||
ReDim vValue(0 To iCols - 1)
|
||||
iArray = 0
|
||||
Else ' Matrix with content
|
||||
lSearch = lPosition + Len(sName) + Len(cstEqualArray) - 1
|
||||
sDim = Utils._RegexSearch(vString(i), "\([0-9]+,", lSearch) ' e.g. (10,
|
||||
iRows = CInt(Mid(sDim, 2, Len(sDim) - 2))
|
||||
sDim = Utils._RegexSearch(vString(i), ",[0-9]+\)", lSearch) ' e.g. ,20)
|
||||
iCols = CInt(Mid(sDim, 2, Len(sDim) - 2))
|
||||
ReDim vValue(0 To iRows - 1)
|
||||
iArray = 0
|
||||
End If
|
||||
ElseIf InStr(vString(i), cstEqual) = lPosition + Len(sName) Then
|
||||
vValue = Utils._CVar(Mid(vString(i), Len(sName) + Len(cstEqual) + 1))
|
||||
_SetPropertyValue(vResult, sName, vValue)
|
||||
Else
|
||||
Exit Function
|
||||
End If
|
||||
Else ' Line is an array row
|
||||
If iRows = 0 Then
|
||||
vValue = Utils._CVar(vString(i), True) ' Keep dates as strings
|
||||
iArray = -1
|
||||
_SetPropertyValue(vResult, sName, vValue)
|
||||
Else
|
||||
vValue(iArray) = Utils._CVar(vString(i), True)
|
||||
If iArray < iRows - 1 Then
|
||||
iArray = iArray + 1
|
||||
Else
|
||||
iArray = -1
|
||||
_SetPropertyValue(vResult, sName, vValue)
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
Next i
|
||||
|
||||
_StrToPropValues = vResult
|
||||
|
||||
End Function
|
||||
|
||||
</script:module>
|
||||
Reference in New Issue
Block a user