mirror of
https://gitee.com/kekingcn/file-online-preview.git
synced 2026-03-15 21:53:46 +08:00
更新windows内置office目录名, 适配jodconverter
This commit is contained in:
陈精华
967
server/libreoffice/share/basic/ScriptForge/SF_Utils.xba
Normal file
967
server/libreoffice/share/basic/ScriptForge/SF_Utils.xba
Normal file
@@ -0,0 +1,967 @@
|
||||
<?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="SF_Utils" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
|
||||
REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
|
||||
REM === Full documentation is available on https://help.libreoffice.org/ ===
|
||||
REM =======================================================================================================================
|
||||
|
||||
Option Explicit
|
||||
Option Private Module
|
||||
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
''' SF_Utils
|
||||
''' ========
|
||||
''' FOR INTERNAL USE ONLY
|
||||
''' Groups all private functions used by the official modules
|
||||
''' Declares the Global variable _SF_
|
||||
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
||||
|
||||
REM ===================================================================== GLOBALS
|
||||
|
||||
Global _SF_ As Variant ' SF_Root (Basic) object)
|
||||
|
||||
''' ScriptForge version
|
||||
Const SF_Version = "7.1"
|
||||
|
||||
''' Standard symbolic names for VarTypes
|
||||
' V_EMPTY = 0
|
||||
' V_NULL = 1
|
||||
' V_INTEGER = 2
|
||||
' V_LONG = 3
|
||||
' V_SINGLE = 4
|
||||
' V_DOUBLE = 5
|
||||
' V_CURRENCY = 6
|
||||
' V_DATE = 7
|
||||
' V_STRING = 8
|
||||
''' Additional symbolic names for VarTypes
|
||||
Global Const V_OBJECT = 9
|
||||
Global Const V_BOOLEAN = 11
|
||||
Global Const V_VARIANT = 12
|
||||
Global Const V_BYTE = 17
|
||||
Global Const V_USHORT = 18
|
||||
Global Const V_ULONG = 19
|
||||
Global Const V_BIGINT = 35
|
||||
Global Const V_DECIMAL = 37
|
||||
Global Const V_ARRAY = 8192
|
||||
Global Const V_NUMERIC = 99 ' Fictive VarType synonym of any numeric value
|
||||
|
||||
REM ================================================================== EXCEPTIONS
|
||||
|
||||
Const MISSINGARGERROR = "MISSINGARGERROR" ' A mandatory argument is missing
|
||||
Const ARGUMENTERROR = "ARGUMENTERROR" ' An argument does not pass the _Validate() validation
|
||||
Const ARRAYERROR = "ARRAYERROR" ' An argument does not pass the _ValidateArray() validation
|
||||
Const FILEERROR = "FILEERROR" ' An argument does not pass the _ValidateFile() validation
|
||||
|
||||
REM =========================================pvA==================== PRIVATE METHODS
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _CDateToIso(pvDate As Variant) As Variant
|
||||
''' Returns a string representation of the given Basic date
|
||||
''' Dates as strings are essential in property values, where Basic dates are evil
|
||||
|
||||
Dim sIsoDate As Variant ' Return value
|
||||
|
||||
If VarType(pvDate) = V_DATE Then
|
||||
If Year(pvDate) < 1900 Then ' Time only
|
||||
sIsoDate = Right("0" & Hour(pvDate), 2) & ":" & Right("0" & Minute(pvDate), 2) & ":" & Right("0" & Second(pvDate), 2)
|
||||
ElseIf Hour(pvDate) + Minute(pvDate) + Second(pvDate) = 0 Then ' Date only
|
||||
sIsoDate = Year(pvDate) & "-" & Right("0" & Month(pvDate), 2) & "-" & Right("0" & Day(pvDate), 2)
|
||||
Else
|
||||
sIsoDate = Year(pvDate) & "-" & Right("0" & Month(pvDate), 2) & "-" & Right("0" & Day(pvDate), 2) _
|
||||
& " " & Right("0" & Hour(pvDate), 2) & ":" & Right("0" & Minute(pvDate), 2) _
|
||||
& ":" & Right("0" & Second(pvDate), 2)
|
||||
End If
|
||||
Else
|
||||
sIsoDate = pvDate
|
||||
End If
|
||||
|
||||
_CDateToIso = sIsoDate
|
||||
|
||||
End Function ' ScriptForge.SF_Utils._CDateToIso
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _CDateToUnoDate(pvDate As Variant) As Variant
|
||||
''' Returns a UNO com.sun.star.util.DateTime/Date/Time object depending on the given date
|
||||
''' by using the appropriate CDateToUnoDateXxx builtin function
|
||||
''' UNO dates are essential in property values, where Basic dates are evil
|
||||
|
||||
Dim vUnoDate As Variant ' Return value
|
||||
|
||||
If VarType(pvDate) = V_DATE Then
|
||||
If Year(pvDate) < 1900 Then
|
||||
vUnoDate = CDateToUnoTime(pvDate)
|
||||
ElseIf Hour(pvDate) + Minute(pvDate) + Second(pvDate) = 0 Then
|
||||
vUnoDate = CDateToUnoDate(pvDate)
|
||||
Else
|
||||
vUnoDate = CDateToUnoDateTime(pvDate)
|
||||
End If
|
||||
Else
|
||||
vUnoDate = pvDate
|
||||
End If
|
||||
|
||||
_CDateToUnoDate = vUnoDate
|
||||
|
||||
End Function ' ScriptForge.SF_Utils._CDateToUnoDate
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _CPropertyValue(ByRef pvValue As Variant) As Variant
|
||||
''' Set a value of a correct type in a com.sun.star.beans.PropertyValue
|
||||
''' Date BASIC variables give error. Change them to UNO types
|
||||
''' Empty arrays should be replaced by Null
|
||||
|
||||
Dim vValue As Variant ' Return value
|
||||
|
||||
If VarType(pvValue) = V_DATE Then
|
||||
vValue = SF_Utils._CDateToUnoDate(pvValue)
|
||||
ElseIf IsArray(pvValue) Then
|
||||
If UBound(pvValue, 1) < LBound(pvValue, 1) Then vValue = Null Else vValue = pvValue
|
||||
Else
|
||||
vValue = pvValue
|
||||
End If
|
||||
_CPropertyValue() = vValue
|
||||
|
||||
End Function ' ScriptForge.SF_Utils._CPropertyValue
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _CStrToDate(ByRef pvStr As String) As Date
|
||||
''' Attempt to convert the input string to a Date variable with the CDate builtin function
|
||||
''' If not successful, returns conventionally -1 (29/12/1899)
|
||||
''' Date patterns: YYYY-MM-DD, HH:MM:DD and YYYY-MM-DD HH:MM:DD
|
||||
|
||||
Dim dDate As Date ' Return value
|
||||
Const cstNoDate = -1
|
||||
|
||||
dDate = cstNoDate
|
||||
Try:
|
||||
On Local Error Resume Next
|
||||
dDate = CDate(pvStr)
|
||||
|
||||
Finally:
|
||||
_CStrToDate = dDate
|
||||
Exit Function
|
||||
End Function ' ScriptForge.SF_Utils._CStrToDate
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _EnterFunction(ByVal psSub As String, Optional ByVal psArgs As String)
|
||||
''' Called on top of each public function
|
||||
''' Used to trace routine in/outs (debug mode)
|
||||
''' and to allow the explicit mention of the user call which caused an error
|
||||
''' Args:
|
||||
''' psSub = the called Sub/Function/Property, usually something like "service.sub"
|
||||
''' Return: True when psSub is called from a user script
|
||||
''' Used to bypass the validation of the arguments when unnecessary
|
||||
|
||||
If IsEmpty(_SF_) Or IsNull(_SF_) Then SF_Utils._InitializeRoot() ' First use of ScriptForge during current LibO session
|
||||
If IsMissing(psArgs) Then psArgs = ""
|
||||
With _SF_
|
||||
If .StackLevel = 0 Then
|
||||
.MainFunction = psSub
|
||||
.MainFunctionArgs = psArgs
|
||||
_EnterFunction = True
|
||||
Else
|
||||
_EnterFunction = False
|
||||
End If
|
||||
.StackLevel = .StackLevel + 1
|
||||
If .DebugMode Then ._AddToConsole("==> " & psSub & "(" & .StackLevel & ")")
|
||||
End With
|
||||
|
||||
End Function ' ScriptForge.SF_Utils._EnterFunction
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _ErrorHandling(Optional ByVal pbErrorHandler As Boolean) As Boolean
|
||||
''' Error handling is normally ON and can be set OFF for debugging purposes
|
||||
''' Each user visible routine starts with a call to this function to enable/disable
|
||||
''' standard handling of internal errors
|
||||
''' Args:
|
||||
''' pbErrorHandler = if present, set its value
|
||||
''' Return: the current value of the error handler
|
||||
|
||||
If IsEmpty(_SF_) Or IsNull(_SF_) Then SF_Utils._InitializeRoot() ' First use of ScriptForge during current LibO session
|
||||
If Not IsMissing(pbErrorHandler) Then _SF_.ErrorHandler = pbErrorHandler
|
||||
_ErrorHandling = _SF_.ErrorHandler
|
||||
|
||||
End Function ' ScriptForge.SF_Utils._ErrorHandling
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Sub _ExitFunction(ByVal psSub As String)
|
||||
''' Called in the Finally block of each public function
|
||||
''' Manage ScriptForge internal aborts
|
||||
''' Resets MainFunction (root) when exiting the method called by a user script
|
||||
''' Used to trace routine in/outs (debug mode)
|
||||
''' Args:
|
||||
''' psSub = the called Sub/Function/Property, usually something like "service.sub"
|
||||
|
||||
If IsEmpty(_SF_) Or IsNull(_SF_) Then SF_Utils._InitializeRoot() ' Useful only when current module has been recompiled
|
||||
With _SF_
|
||||
If Err > 0 Then
|
||||
SF_Exception.RaiseAbort(psSub)
|
||||
End If
|
||||
If .StackLevel = 1 Then
|
||||
.MainFunction = ""
|
||||
.MainFunctionArgs = ""
|
||||
End If
|
||||
If .DebugMode Then ._AddToConsole("<== " & psSub & "(" & .StackLevel & ")")
|
||||
If .StackLevel > 0 Then .StackLevel = .StackLevel - 1
|
||||
End With
|
||||
|
||||
End Sub ' ScriptForge.SF_Utils._ExitFunction
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Sub _ExportScriptForgePOTFile(ByVal FileName As String)
|
||||
''' Export the ScriptForge POT file related to its own user interface
|
||||
''' Should be called only before issuing new ScriptForge releases only
|
||||
''' Args:
|
||||
''' FileName: the resulting file. If it exists, is overwritten without warning
|
||||
|
||||
Dim sHeader As String ' The specific header to insert
|
||||
|
||||
sHeader = "" _
|
||||
& "*********************************************************************\n" _
|
||||
& "*** The ScriptForge library and its associated libraries ***\n" _
|
||||
& "*** are part of the LibreOffice project. ***\n" _
|
||||
& "*********************************************************************\n" _
|
||||
& "\n" _
|
||||
& "ScriptForge Release " & SF_Version & "\n" _
|
||||
& "-----------------------"
|
||||
|
||||
Try:
|
||||
With _SF_
|
||||
.Interface.ExportToPOTFile(FileName, Header := sHeader)
|
||||
End With
|
||||
|
||||
Finally:
|
||||
Exit Sub
|
||||
End Sub ' ScriptForge.SF_Utils._ExportScriptForgePOTFile
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _GetPropertyValue(ByRef pvArgs As Variant, ByVal psName As String) As Variant
|
||||
''' Returns the Value corresponding to the given name
|
||||
''' Args
|
||||
''' pvArgs: a zero_based array of PropertyValues
|
||||
''' psName: the comparison is not case-sensitive
|
||||
''' Returns:
|
||||
''' Zero-length string if not found
|
||||
|
||||
Dim vValue As Variant ' Return value
|
||||
Dim i As Long
|
||||
|
||||
vValue = ""
|
||||
If IsArray(pvArgs) Then
|
||||
For i = LBound(pvArgs) To UBound(pvArgs)
|
||||
If UCase(psName) = UCase(pvArgs(i).Name) Then
|
||||
vValue = pvArgs(i).Value
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
End If
|
||||
_GetPropertyValue = vValue
|
||||
|
||||
End Function ' ScriptForge.SF_Utils._GetPropertyValue
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _GetRegistryKeyContent(ByVal psKeyName as string _
|
||||
, Optional pbForUpdate as Boolean _
|
||||
) As Variant
|
||||
''' Implement a ConfigurationProvider service
|
||||
''' Derived from the Tools library
|
||||
''' Args:
|
||||
''' psKeyName: the name of the node in the configuration tree
|
||||
''' pbForUpdate: default = False
|
||||
|
||||
Dim oConfigProvider as Object ' com.sun.star.configuration.ConfigurationProvider
|
||||
Dim vNodePath(0) as New com.sun.star.beans.PropertyValue
|
||||
Dim sConfig As String ' One of next 2 constants
|
||||
Const cstConfig = "com.sun.star.configuration.ConfigurationAccess"
|
||||
Const cstConfigUpdate = "com.sun.star.configuration.ConfigurationUpdateAccess"
|
||||
|
||||
Set oConfigProvider = _GetUNOService("ConfigurationProvider")
|
||||
vNodePath(0).Name = "nodepath"
|
||||
vNodePath(0).Value = psKeyName
|
||||
|
||||
If IsMissing(pbForUpdate) Then pbForUpdate = False
|
||||
If pbForUpdate Then sConfig = cstConfigUpdate Else sConfig = cstConfig
|
||||
|
||||
Set _GetRegistryKeyContent = oConfigProvider.createInstanceWithArguments(sConfig, vNodePath())
|
||||
|
||||
End Function ' ScriptForge.SF_Utils._GetRegistryKeyContent
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _GetUNOService(ByVal psService As String _
|
||||
, Optional ByVal pvArg As Variant _
|
||||
) As Object
|
||||
''' Create a UNO service
|
||||
''' Each service is called only once
|
||||
''' Args:
|
||||
''' psService: shortcut to service
|
||||
''' pvArg: some services might require an argument
|
||||
|
||||
Dim sLocale As String ' fr-BE f.i.
|
||||
Dim oConfigProvider As Object
|
||||
Dim oDefaultContext As Object
|
||||
Dim vNodePath As Variant
|
||||
|
||||
Set _GetUNOService = Nothing
|
||||
With _SF_
|
||||
Select Case psService
|
||||
Case "BrowseNodeFactory"
|
||||
Set oDefaultContext = GetDefaultContext()
|
||||
If Not IsNull(oDefaultContext) Then Set _GetUNOService = oDefaultContext.getValueByName("/singletons/com.sun.star.script.browse.theBrowseNodeFactory")
|
||||
Case "CharacterClass"
|
||||
If IsEmpty(.CharacterClass) Or IsNull(.CharacterClass) Then
|
||||
Set .CharacterClass = CreateUnoService("com.sun.star.i18n.CharacterClassification")
|
||||
End If
|
||||
Set _GetUNOService = .CharacterClass
|
||||
Case "ConfigurationProvider"
|
||||
If IsEmpty(.ConfigurationProvider) Or IsNull(.ConfigurationProvider) Then
|
||||
Set .ConfigurationProvider = CreateUnoService("com.sun.star.configuration.ConfigurationProvider")
|
||||
End If
|
||||
Set _GetUNOService = .ConfigurationProvider
|
||||
Case "CoreReflection"
|
||||
If IsEmpty(.CoreReflection) Or IsNull(.CoreReflection) Then
|
||||
Set .CoreReflection = CreateUnoService("com.sun.star.reflection.CoreReflection")
|
||||
End If
|
||||
Set _GetUNOService = .CoreReflection
|
||||
Case "DatabaseContext"
|
||||
If IsEmpty(.DatabaseContext) Or IsNull(.DatabaseContext) Then
|
||||
Set .DatabaseContext = CreateUnoService("com.sun.star.sdb.DatabaseContext")
|
||||
End If
|
||||
Set _GetUNOService = .DatabaseContext
|
||||
Case "DispatchHelper"
|
||||
If IsEmpty(.DispatchHelper) Or IsNull(.DispatchHelper) Then
|
||||
Set .DispatchHelper = CreateUnoService("com.sun.star.frame.DispatchHelper")
|
||||
End If
|
||||
Set _GetUNOService = .DispatchHelper
|
||||
Case "FileAccess"
|
||||
If IsEmpty(.FileAccess) Or IsNull(.FileAccess) Then
|
||||
Set .FileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
|
||||
End If
|
||||
Set _GetUNOService = .FileAccess
|
||||
Case "FilePicker"
|
||||
If IsEmpty(.FilePicker) Or IsNull(.FilePicker) Then
|
||||
Set .FilePicker = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
|
||||
End If
|
||||
Set _GetUNOService = .FilePicker
|
||||
Case "FilterFactory"
|
||||
If IsEmpty(.FilterFactory) Or IsNull(.FilterFactory) Then
|
||||
Set .FilterFactory = CreateUnoService("com.sun.star.document.FilterFactory")
|
||||
End If
|
||||
Set _GetUNOService = .FilterFactory
|
||||
Case "FolderPicker"
|
||||
If IsEmpty(.FolderPicker) Or IsNull(.FolderPicker) Then
|
||||
Set .FolderPicker = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")
|
||||
End If
|
||||
Set _GetUNOService = .FolderPicker
|
||||
Case "FunctionAccess"
|
||||
If IsEmpty(.FunctionAccess) Or IsNull(.FunctionAccess) Then
|
||||
Set .FunctionAccess = CreateUnoService("com.sun.star.sheet.FunctionAccess")
|
||||
End If
|
||||
Set _GetUNOService = .FunctionAccess
|
||||
Case "Introspection"
|
||||
If IsEmpty(.Introspection) Or IsNull(.Introspection) Then
|
||||
Set .Introspection = CreateUnoService("com.sun.star.beans.Introspection")
|
||||
End If
|
||||
Set _GetUNOService = .Introspection
|
||||
Case "Locale"
|
||||
If IsEmpty(.Locale) Or IsNull(.Locale) Then
|
||||
.Locale = CreateUnoStruct("com.sun.star.lang.Locale")
|
||||
' Derived from the Tools library
|
||||
Set oConfigProvider = createUnoService("com.sun.star.configuration.ConfigurationProvider")
|
||||
vNodePath = Array() : ReDim vNodePath(0)
|
||||
vNodePath(0) = New com.sun.star.beans.PropertyValue
|
||||
vNodePath(0).Name = "nodepath" : vNodePath(0).Value = "org.openoffice.Setup/L10N"
|
||||
sLocale = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess", vNodePath()).getByName("ooLocale")
|
||||
.Locale.Language = Left(sLocale, 2)
|
||||
.Locale.Country = Right(sLocale, 2)
|
||||
End If
|
||||
Set _GetUNOService = .Locale
|
||||
Case "MacroExpander"
|
||||
Set oDefaultContext = GetDefaultContext()
|
||||
If Not IsNull(oDefaultContext) Then Set _GetUNOService = oDefaultContext.getValueByName("/singletons/com.sun.star.util.theMacroExpander")
|
||||
Case "MailService"
|
||||
If IsEmpty(.MailService) Or IsNull(.MailService) Then
|
||||
If GetGuiType = 1 Then ' Windows
|
||||
Set .MailService = CreateUnoService("com.sun.star.system.SimpleSystemMail")
|
||||
Else
|
||||
Set .MailService = CreateUnoService("com.sun.star.system.SimpleCommandMail")
|
||||
End If
|
||||
End If
|
||||
Set _GetUNOService = .MailService
|
||||
Case "PathSettings"
|
||||
If IsEmpty(.PathSettings) Or IsNull(.PathSettings) Then
|
||||
Set .PathSettings = CreateUnoService("com.sun.star.util.PathSettings")
|
||||
End If
|
||||
Set _GetUNOService = .PathSettings
|
||||
Case "PathSubstitution"
|
||||
If IsEmpty(.PathSubstitution) Or IsNull(.PathSubstitution) Then
|
||||
Set .PathSubstitution = CreateUnoService("com.sun.star.util.PathSubstitution")
|
||||
End If
|
||||
Set _GetUNOService = .PathSubstitution
|
||||
Case "ScriptProvider"
|
||||
If IsMissing(pvArg) Then pvArg = SF_Session.SCRIPTISAPPLICATION
|
||||
Select Case LCase(pvArg)
|
||||
Case SF_Session.SCRIPTISEMBEDDED ' Document
|
||||
If Not IsNull(ThisComponent) Then Set _GetUNOService = ThisComponent.getScriptProvider()
|
||||
Case Else
|
||||
If IsEmpty(.ScriptProvider) Or IsNull(.ScriptProvider) Then
|
||||
Set .ScriptProvider = _
|
||||
CreateUnoService("com.sun.star.script.provider.MasterScriptProviderFactory").createScriptProvider("")
|
||||
End If
|
||||
Set _GetUNOService = .ScriptProvider
|
||||
End Select
|
||||
Case "SearchOptions"
|
||||
If IsEmpty(.SearchOptions) Or IsNull(.SearchOptions) Then
|
||||
Set .SearchOptions = New com.sun.star.util.SearchOptions
|
||||
With .SearchOptions
|
||||
.algorithmType = com.sun.star.util.SearchAlgorithms.REGEXP
|
||||
.searchFlag = 0
|
||||
End With
|
||||
End If
|
||||
Set _GetUNOService = .SearchOptions
|
||||
Case "SystemShellExecute"
|
||||
If IsEmpty(.SystemShellExecute) Or IsNull(.SystemShellExecute) Then
|
||||
Set .SystemShellExecute = CreateUnoService("com.sun.star.system.SystemShellExecute")
|
||||
End If
|
||||
Set _GetUNOService = .SystemShellExecute
|
||||
Case "TextSearch"
|
||||
If IsEmpty(.TextSearch) Or IsNull(.TextSearch) Then
|
||||
Set .TextSearch = CreateUnoService("com.sun.star.util.TextSearch")
|
||||
End If
|
||||
Set _GetUNOService = .TextSearch
|
||||
Case "URLTransformer"
|
||||
If IsEmpty(.URLTransformer) Or IsNull(.URLTransformer) Then
|
||||
Set .URLTransformer = CreateUnoService("com.sun.star.util.URLTransformer")
|
||||
End If
|
||||
Set _GetUNOService = .URLTransformer
|
||||
Case Else
|
||||
End Select
|
||||
End With
|
||||
|
||||
End Function ' ScriptForge.SF_Utils._GetUNOService
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Sub _InitializeRoot(Optional ByVal pbForce As Boolean)
|
||||
''' Initialize _SF_ as SF_Root basic object
|
||||
''' Args:
|
||||
''' pbForce = True forces the reinit (default = False)
|
||||
|
||||
If IsMissing(pbForce) Then pbForce = False
|
||||
If pbForce Then Set _SF_ = Nothing
|
||||
If IsEmpty(_SF_) Or IsNull(_SF_) Then
|
||||
Set _SF_ = New SF_Root
|
||||
Set _SF_.[Me] = _SF_
|
||||
' Localization
|
||||
_SF_._LoadLocalizedInterface()
|
||||
End If
|
||||
|
||||
End Sub ' ScriptForge.SF_Utils._InitializeRoot
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _MakePropertyValue(ByVal psName As String _
|
||||
, ByRef 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
|
||||
|
||||
With oPropertyValue
|
||||
.Name = psName
|
||||
.Value = SF_Utils._CPropertyValue(pvValue)
|
||||
End With
|
||||
_MakePropertyValue() = oPropertyValue
|
||||
|
||||
End Function ' ScriptForge.SF_Utils._MakePropertyValue
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _Repr(ByVal pvArg As Variant, Optional ByVal plMax As Long) As String
|
||||
''' Convert pvArg into a readable string (truncated if length > plMax)
|
||||
''' Args
|
||||
''' pvArg: may be of any type
|
||||
''' plMax: maximum length of the resulting string (default = 32K)
|
||||
|
||||
Dim sArg As String ' Return value
|
||||
Dim oObject As Object ' Alias of argument to avoid "Object variable not set"
|
||||
Dim sObject As String ' Object representation
|
||||
Dim sObjectType As String ' ObjectType attribute of Basic objects
|
||||
Dim sLength As String ' String length as a string
|
||||
Dim i As Long
|
||||
Const cstBasicObject = "com.sun.star.script.NativeObjectWrapper"
|
||||
|
||||
Const cstMaxLength = 2^15 - 1 ' 32767
|
||||
Const cstByteLength = 25
|
||||
Const cstEtc = " … "
|
||||
|
||||
If IsMissing(plMax) Or plMax = 0 Then plMax = cstMaxLength
|
||||
If IsArray(pvArg) Then
|
||||
sArg = SF_Array._Repr(pvArg)
|
||||
Else
|
||||
Select Case VarType(pvArg)
|
||||
Case V_EMPTY : sArg = "[EMPTY]"
|
||||
Case V_NULL : sArg = "[NULL]"
|
||||
Case V_OBJECT
|
||||
If IsNull(pvArg) Then
|
||||
sArg = "[NULL]"
|
||||
Else
|
||||
sObject = SF_Session.UnoObjectType(pvArg)
|
||||
If sObject = "" Or sObject = cstBasicObject Then ' Not a UNO object
|
||||
' Test if argument is a ScriptForge object
|
||||
sObjectType = ""
|
||||
On Local Error Resume Next
|
||||
Set oObject = pvArg
|
||||
sObjectType = oObject.ObjectType
|
||||
On Error GoTo 0
|
||||
If sObjectType = "" Then
|
||||
sArg = "[OBJECT]"
|
||||
ElseIf Left(sObjectType, 3) = "SF_" Then
|
||||
sArg = "[" & sObjectType & "]"
|
||||
Else
|
||||
sArg = oObject._Repr()
|
||||
End If
|
||||
Else
|
||||
sArg = "[" & sObject & "]"
|
||||
End If
|
||||
End If
|
||||
Case V_VARIANT : sArg = "[VARIANT]"
|
||||
Case V_STRING
|
||||
sArg = SF_String._Repr(pvArg)
|
||||
Case V_BOOLEAN : sArg = Iif(pvArg, "[TRUE]", "[FALSE]")
|
||||
Case V_BYTE : sArg = Right("00" & Hex(pvArg), 2)
|
||||
Case V_SINGLE, V_DOUBLE, V_CURRENCY
|
||||
sArg = Format(pvArg)
|
||||
If InStr(1, sArg, "E", 1) = 0 Then sArg = Format(pvArg, "##0.0##")
|
||||
sArg = Replace(sArg, ",", ".") 'Force decimal point
|
||||
Case V_BIGINT : sArg = CStr(CLng(pvArg))
|
||||
Case V_DATE : sArg = _CDateToIso(pvArg)
|
||||
Case Else : sArg = CStr(pvArg)
|
||||
End Select
|
||||
End If
|
||||
If Len(sArg) > plMax Then
|
||||
sLength = "(" & Len(sArg) & ")"
|
||||
sArg = Left(sArg, plMax - Len(cstEtc) - Len(slength)) & cstEtc & sLength
|
||||
End If
|
||||
_Repr = sArg
|
||||
|
||||
End Function ' ScriptForge.SF_Utils._Repr
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Private Function _ReprValues(Optional ByVal pvArgs As Variant _
|
||||
, Optional ByVal plMax As Long _
|
||||
) As String
|
||||
''' Convert an array of values to a comma-separated list of readable strings
|
||||
|
||||
Dim sValues As String ' Return value
|
||||
Dim sValue As String ' A single value
|
||||
Dim vValue As Variant ' A single item in the argument
|
||||
Dim i As Long ' Items counter
|
||||
Const cstMax = 20 ' Maximum length of single string
|
||||
Const cstContinue = "…" ' Unicode continuation char U+2026
|
||||
|
||||
_ReprValues = ""
|
||||
If IsMissing(pvArgs) Then Exit Function
|
||||
If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs)
|
||||
sValues = ""
|
||||
For i = 0 To UBound(pvArgs)
|
||||
vValue = pvArgs(i)
|
||||
If i < plMax Then
|
||||
If VarType(vValue) = V_STRING Then sValue = """" & vValue & """" Else sValue = SF_Utils._Repr(vValue, cstMax)
|
||||
If Len(sValues) = 0 Then sValues = sValue Else sValues = sValues & ", " & sValue
|
||||
ElseIf i < UBound(pvArgs) Then
|
||||
sValues = sValues & ", " & cstContinue
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
_ReprValues = sValues
|
||||
|
||||
End Function ' ScriptForge.SF_Utils._ReprValues
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Sub _SetPropertyValue(ByRef pvPropertyValue As Variant _
|
||||
, ByVal psName As String _
|
||||
, ByRef pvValue As Variant _
|
||||
)
|
||||
''' Update the 1st argument (passed by reference), which is an array of property values
|
||||
''' If the property psName exists, update it with pvValue, otherwise create it on top of the array
|
||||
|
||||
Dim oPropertyValue As New com.sun.star.beans.PropertyValue
|
||||
Dim lIndex As Long ' Found entry
|
||||
Dim vValue As Variant ' Alias of pvValue
|
||||
Dim i As Long
|
||||
|
||||
lIndex = -1
|
||||
For i = 0 To UBound(pvPropertyValue)
|
||||
If pvPropertyValue(i).Name = psName Then
|
||||
lIndex = i
|
||||
Exit For
|
||||
End If
|
||||
Next i
|
||||
If lIndex < 0 Then ' Not found
|
||||
lIndex = UBound(pvPropertyValue) + 1
|
||||
ReDim Preserve pvPropertyValue(0 To lIndex)
|
||||
Set oPropertyValue = SF_Utils._MakePropertyValue(psName, pvValue)
|
||||
pvPropertyValue(lIndex) = oPropertyValue
|
||||
Else ' psName exists already in array of property values
|
||||
pvPropertyValue(lIndex).Value = SF_Utils._CPropertyValue(pvValue)
|
||||
End If
|
||||
|
||||
End Sub ' ScriptForge.SF_Utils._SetPropertyValue
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Private Function _TypeNames(Optional ByVal pvArgs As Variant) As String
|
||||
''' Converts the array of VarTypes to a comma-separated list of TypeNames
|
||||
|
||||
Dim sTypes As String ' Return value
|
||||
Dim sType As String ' A single type
|
||||
Dim iType As Integer ' A single item of the argument
|
||||
|
||||
_TypeNames = ""
|
||||
If IsMissing(pvArgs) Then Exit Function
|
||||
If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs)
|
||||
sTypes = ""
|
||||
For Each iType In pvArgs
|
||||
Select Case iType
|
||||
Case V_EMPTY : sType = "Empty"
|
||||
Case V_NULL : sType = "Null"
|
||||
Case V_INTEGER : sType = "Integer"
|
||||
Case V_LONG : sType = "Long"
|
||||
Case V_SINGLE : sType = "Single"
|
||||
Case V_DOUBLE : sType = "Double"
|
||||
Case V_CURRENCY : sType = "Currency"
|
||||
Case V_DATE : sType = "Date"
|
||||
Case V_STRING : sType = "String"
|
||||
Case V_OBJECT : sType = "Object"
|
||||
Case V_BOOLEAN : sType = "Boolean"
|
||||
Case V_VARIANT : sType = "Variant"
|
||||
Case V_DECIMAL : sType = "Decimal"
|
||||
Case >= V_ARRAY : sType = "Array"
|
||||
Case V_NUMERIC : sType = "Numeric"
|
||||
End Select
|
||||
If Len(sTypes) = 0 Then sTypes = sType Else sTypes = sTypes & ", " & sType
|
||||
Next iType
|
||||
_TypeNames = sTypes
|
||||
|
||||
End Function ' ScriptForge.SF_Utils._TypeNames
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _Validate(Optional ByRef pvArgument As Variant _
|
||||
, ByVal psName As String _
|
||||
, Optional ByVal pvTypes As Variant _
|
||||
, Optional ByVal pvValues As Variant _
|
||||
, Optional ByVal pvRegex As Variant _
|
||||
, Optional ByVal pvObjectType As Variant _
|
||||
) As Boolean
|
||||
''' Validate the arguments set by user scripts
|
||||
''' The arguments of the function define the validation rules
|
||||
''' This function ignores arrays. Use _ValidateArray instead
|
||||
''' Args:
|
||||
''' pvArgument: the argument to (in)validate
|
||||
''' psName: the documented name of the argument (can be inserted in an error message)
|
||||
''' pvTypes: array of allowed VarTypes
|
||||
''' pvValues: array of allowed values
|
||||
''' pvRegex: regular expression to comply with
|
||||
''' pvObjectType: mandatory Basic class
|
||||
''' Return: True if validation OK
|
||||
''' Otherwise an error is raised
|
||||
''' Exceptions:
|
||||
''' ARGUMENTERROR
|
||||
|
||||
Dim iVarType As Integer ' Extended VarType of argument
|
||||
Dim bValid As Boolean ' Returned value
|
||||
Dim oArgument As Variant ' Workaround "Object variable not set" error on 1st executable statement
|
||||
Const cstMaxLength = 256 ' Maximum length of readable value
|
||||
Const cstMaxValues = 10 ' Maximum number of allowed items to list in an error message
|
||||
|
||||
' To avoid useless recursions, keep main function, only increase stack depth
|
||||
_SF_.StackLevel = _SF_.StackLevel + 1
|
||||
On Local Error GoTo Finally ' Do never interrupt
|
||||
|
||||
Try:
|
||||
bValid = True
|
||||
If IsMissing(pvArgument) Then GoTo CatchMissing
|
||||
If IsMissing(pvRegex) Or IsEmpty(pvRegex) Then pvRegex = ""
|
||||
If IsMissing(pvObjectType) Or IsEmpty(pvObjectType) Then pvObjectType = ""
|
||||
iVarType = SF_Utils._VarTypeExt(pvArgument)
|
||||
|
||||
' Arrays NEVER pass validation
|
||||
If iVarType >= V_ARRAY Then
|
||||
bValid = False
|
||||
Else
|
||||
' Check existence of argument
|
||||
bValid = iVarType <> V_NULL And iVarType <> V_EMPTY
|
||||
' Check if argument's VarType is valid
|
||||
If bValid And Not IsMissing(pvTypes) Then
|
||||
If Not IsArray(pvTypes) Then bValid = ( pvTypes = iVarType ) Else bValid = SF_Array.Contains(pvTypes, iVarType)
|
||||
End If
|
||||
' Check if argument's value is valid
|
||||
If bValid And Not IsMissing(pvValues) Then
|
||||
If Not IsArray(pvValues) Then pvValues = Array(pvValues)
|
||||
bValid = SF_Array.Contains(pvValues, pvArgument, CaseSensitive := False)
|
||||
End If
|
||||
' Check regular expression
|
||||
If bValid And Len(pvRegex) > 0 And iVarType = V_STRING Then
|
||||
If Len(pvArgument) > 0 Then bValid = SF_String.IsRegex(pvArgument, pvRegex, CaseSensitive := False)
|
||||
End If
|
||||
' Check instance types
|
||||
If bValid And Len(pvObjectType) > 0 And iVarType = V_OBJECT Then
|
||||
Set oArgument = pvArgument
|
||||
bValid = ( pvObjectType = oArgument.ObjectType )
|
||||
End If
|
||||
End If
|
||||
|
||||
If Not bValid Then
|
||||
''' Library: ScriptForge
|
||||
''' Service: Array
|
||||
''' Method: Contains
|
||||
''' Arguments: Array_1D, ToFind, [CaseSensitive=False], [SortOrder=""]
|
||||
''' A serious error has been detected on argument SortOrder
|
||||
''' Rules: SortOrder is of type String
|
||||
''' SortOrder must contain one of next values: "ASC", "DESC", ""
|
||||
''' Actual value: "Ascending"
|
||||
SF_Exception.RaiseFatal(ARGUMENTERROR _
|
||||
, SF_Utils._Repr(pvArgument, cstMaxLength), psName, SF_Utils._TypeNames(pvTypes) _
|
||||
, SF_Utils._ReprValues(pvValues, cstMaxValues), pvRegex, pvObjectType _
|
||||
)
|
||||
End If
|
||||
|
||||
Finally:
|
||||
_Validate = bValid
|
||||
_SF_.StackLevel = _SF_.StackLevel - 1
|
||||
Exit Function
|
||||
CatchMissing:
|
||||
bValid = False
|
||||
SF_Exception.RaiseFatal(MISSINGARGERROR, psName)
|
||||
GoTo Finally
|
||||
End Function ' ScriptForge.SF_Utils._Validate
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _ValidateArray(Optional ByRef pvArray As Variant _
|
||||
, ByVal psName As String _
|
||||
, Optional ByVal piDimensions As Integer _
|
||||
, Optional ByVal piType As Integer _
|
||||
, Optional ByVal pbNotNull As Boolean _
|
||||
) As Boolean
|
||||
''' Validate the (array) arguments set by user scripts
|
||||
''' The arguments of the function define the validation rules
|
||||
''' This function ignores non-arrays. Use _Validate instead
|
||||
''' Args:
|
||||
''' pvArray: the argument to (in)validate
|
||||
''' psName: the documented name of the array (can be inserted in an error message)
|
||||
''' piDimensions: the # of dimensions the array must have. 0 = Any (default)
|
||||
''' piType: (default = -1, i.e. not applicable)
|
||||
''' For 2D arrays, the 1st column is checked
|
||||
''' 0 => all items must be any out of next types: string, date or numeric,
|
||||
''' but homogeneously: all strings or all dates or all numeric
|
||||
''' V_STRING or V_DATE or V_NUMERIC => that specific type is required
|
||||
''' pbNotNull: piType must be >=0, otherwise ignored
|
||||
''' If True: Empty, Null items are rejected
|
||||
''' Return: True if validation OK
|
||||
''' Otherwise an error is raised
|
||||
''' Exceptions:
|
||||
''' ARRAYERROR
|
||||
|
||||
Dim iVarType As Integer ' VarType of argument
|
||||
Dim vItem As Variant ' Array item
|
||||
Dim iItemType As Integer ' VarType of individual items of argument
|
||||
Dim iDims As Integer ' Number of dimensions of the argument
|
||||
Dim bValid As Boolean ' Returned value
|
||||
Dim iArrayType As Integer ' Static array type
|
||||
Dim iFirstItemType As Integer ' Type of 1st non-null/empty item
|
||||
Dim sType As String ' Allowed item types as a string
|
||||
Dim i As Long
|
||||
Const cstMaxLength = 256 ' Maximum length of readable value
|
||||
|
||||
' To avoid useless recursions, keep main function, only increase stack depth
|
||||
|
||||
_SF_.StackLevel = _SF_.StackLevel + 1
|
||||
On Local Error GoTo Finally ' Do never interrupt
|
||||
|
||||
Try:
|
||||
bValid = True
|
||||
If IsMissing(pvArray) Then GoTo CatchMissing
|
||||
If IsMissing(piDimensions) Then piDimensions = 0
|
||||
If IsMissing(piType) Then piType = -1
|
||||
If IsMissing(pbNotNull) Then pbNotNull = False
|
||||
iVarType = VarType(pvArray)
|
||||
|
||||
' Scalars NEVER pass validation
|
||||
If iVarType < V_ARRAY Then
|
||||
bValid = False
|
||||
Else
|
||||
' Check dimensions
|
||||
iDims = SF_Array.CountDims(pvArray)
|
||||
If iDims > 2 Then bValid = False ' Only 1D and 2D arrays
|
||||
If bValid And piDimensions > 0 Then
|
||||
bValid = ( iDims = piDimensions Or (iDims = 0 And piDimensions = 1) ) ' Allow empty vectors
|
||||
End If
|
||||
' Check VarType and Empty/Null status of the array items
|
||||
If bValid And iDims = 1 And piType >= 0 Then
|
||||
iArrayType = SF_Array._StaticType(pvArray)
|
||||
If (piType = 0 And iArrayType > 0) Or (piType > 0 And iArrayType = piType) Then
|
||||
' If static array of the right VarType ..., OK
|
||||
Else
|
||||
' Go through array and check individual items
|
||||
iFirstItemType = -1
|
||||
For i = LBound(pvArray, 1) To UBound(pvArray, 1)
|
||||
If iDims = 1 Then vItem = pvArray(i) Else vItem = pvArray(i, LBound(pvArray, 2))
|
||||
iItemType = SF_Utils._VarTypeExt(vItem)
|
||||
If iItemType > V_NULL Then ' Exclude Empty and Null
|
||||
' Initialization at first non-null item
|
||||
If iFirstItemType < 0 Then
|
||||
iFirstItemType = iItemType
|
||||
If piType > 0 Then bValid = ( iFirstItemType = piType ) Else bValid = SF_Array.Contains(Array(V_STRING, V_DATE, V_NUMERIC), iFirstItemType)
|
||||
Else
|
||||
bValid = (iItemType = iFirstItemType)
|
||||
End If
|
||||
Else
|
||||
bValid = Not pbNotNull
|
||||
End If
|
||||
If Not bValid Then Exit For
|
||||
Next i
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
|
||||
If Not bValid Then
|
||||
''' Library: ScriptForge
|
||||
''' Service: Array
|
||||
''' Method: Contains
|
||||
''' Arguments: Array_1D, ToFind, [CaseSensitive=False], [SortOrder=""|"ASC"|"DESC"]
|
||||
''' An error was detected on argument Array_1D
|
||||
''' Rules: Array_1D is of type Array
|
||||
''' Array_1D must have maximum 1 dimension
|
||||
''' Array_1D must have all elements of the same type: either String, Date or Numeric
|
||||
''' Actual value: (0:2, 0:3)
|
||||
sType = ""
|
||||
If piType = 0 Then
|
||||
sType = "String, Date, Numeric"
|
||||
ElseIf piType > 0 Then
|
||||
sType = SF_Utils._TypeNames(piType)
|
||||
End If
|
||||
SF_Exception.RaiseFatal(ARRAYERROR _
|
||||
, SF_Utils._Repr(pvArray, cstMaxLength), psName, piDimensions, sType, pbNotNull)
|
||||
End If
|
||||
|
||||
Finally:
|
||||
_ValidateArray = bValid
|
||||
_SF_.StackLevel = _SF_.StackLevel - 1
|
||||
Exit Function
|
||||
CatchMissing:
|
||||
bValid = False
|
||||
SF_Exception.RaiseFatal(MISSINGARGERROR, psName)
|
||||
GoTo Finally
|
||||
End Function ' ScriptForge.SF_Utils._ValidateArray
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _ValidateFile(Optional ByRef pvArgument As Variant _
|
||||
, ByVal psName As String _
|
||||
, Optional ByVal pbWildCards As Boolean _
|
||||
, Optional ByVal pbSpace As Boolean _
|
||||
)
|
||||
''' Validate the argument as a valid FileName
|
||||
''' Args:
|
||||
''' pvArgument: the argument to (in)validate
|
||||
''' pbWildCards: if True, wildcard characters are accepted in the last component of the 1st argument
|
||||
''' pbSpace: if True, the argument may be an empty string. Default = False
|
||||
''' Return: True if validation OK
|
||||
''' Otherwise an error is raised
|
||||
''' Exceptions:
|
||||
''' ARGUMENTERROR
|
||||
|
||||
Dim iVarType As Integer ' VarType of argument
|
||||
Dim sFile As String ' Alias for argument
|
||||
Dim bValid As Boolean ' Returned value
|
||||
Dim sFileNaming As String ' Alias of SF_FileSystem.FileNaming
|
||||
Dim oArgument As Variant ' Workaround "Object variable not set" error on 1st executable statement
|
||||
Const cstMaxLength = 256 ' Maximum length of readable value
|
||||
|
||||
' To avoid useless recursions, keep main function, only increase stack depth
|
||||
|
||||
_SF_.StackLevel = _SF_.StackLevel + 1
|
||||
On Local Error GoTo Finally ' Do never interrupt
|
||||
|
||||
Try:
|
||||
bValid = True
|
||||
If IsMissing(pvArgument) Then GoTo CatchMissing
|
||||
If IsMissing(pbWildCards) Then pbWildCards = False
|
||||
If IsMissing(pbSpace) Then pbSpace = False
|
||||
iVarType = VarType(pvArgument)
|
||||
|
||||
' Arrays NEVER pass validation
|
||||
If iVarType >= V_ARRAY Then
|
||||
bValid = False
|
||||
Else
|
||||
' Argument must be a string containing a valid file name
|
||||
bValid = ( iVarType = V_STRING )
|
||||
If bValid Then
|
||||
bValid = ( Len(pvArgument) > 0 Or pbSpace )
|
||||
If bValid And Len(pvArgument) > 0 Then
|
||||
' Wildcards are replaced by arbitrary alpha characters
|
||||
If pbWildCards Then
|
||||
sFile = Replace(Replace(pvArgument, "?", "Z"), "*", "A")
|
||||
Else
|
||||
sFile = pvArgument
|
||||
bValid = ( InStr(sFile, "?") + InStr(sFile, "*") = 0 )
|
||||
End If
|
||||
' Check file format without wildcards
|
||||
If bValid Then
|
||||
With SF_FileSystem
|
||||
sFileNaming = .FileNaming
|
||||
Select Case sFileNaming
|
||||
Case "ANY" : bValid = SF_String.IsUrl(ConvertToUrl(sFile))
|
||||
Case "URL" : bValid = SF_String.IsUrl(sFile)
|
||||
Case "SYS" : bValid = SF_String.IsFileName(sFile)
|
||||
End Select
|
||||
End With
|
||||
End If
|
||||
' Check that wildcards are only present in last component
|
||||
If bValid And pbWildCards Then
|
||||
sFile = SF_FileSystem.GetParentFolderName(pvArgument)
|
||||
bValid = ( InStr(sFile, "*") + InStr(sFile, "?") + InStr(sFile,"%3F") = 0 ) ' ConvertToUrl replaces ? by %3F
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
|
||||
If Not bValid Then
|
||||
''' Library: ScriptForge
|
||||
''' Service: FileSystem
|
||||
''' Method: CopyFile
|
||||
''' Arguments: Source, Destination
|
||||
''' A serious error has been detected on argument Source
|
||||
''' Rules: Source is of type String
|
||||
''' Source must be a valid file name expressed in operating system notation
|
||||
''' Source may contain one or more wildcard characters in its last component
|
||||
''' Actual value: /home/jean-*/SomeFile.odt
|
||||
SF_Exception.RaiseFatal(FILEERROR _
|
||||
, SF_Utils._Repr(pvArgument, cstMaxLength), psName, pbWildCards)
|
||||
End If
|
||||
|
||||
Finally:
|
||||
_ValidateFile = bValid
|
||||
_SF_.StackLevel = _SF_.StackLevel - 1
|
||||
Exit Function
|
||||
CatchMissing:
|
||||
bValid = False
|
||||
SF_Exception.RaiseFatal(MISSINGARGERROR, psName)
|
||||
GoTo Finally
|
||||
End Function ' ScriptForge.SF_Utils._ValidateFile
|
||||
|
||||
REM -----------------------------------------------------------------------------
|
||||
Public Function _VarTypeExt(ByRef pvValue As Variant) As Integer
|
||||
''' Return the VarType of the argument but all numeric types are aggregated into V_NUMERIC
|
||||
''' Args:
|
||||
''' pvValue: value to examine
|
||||
''' Return:
|
||||
''' The extended VarType
|
||||
|
||||
Dim iType As Integer ' VarType of argument
|
||||
|
||||
iType = VarType(pvValue)
|
||||
Select Case iType
|
||||
Case V_INTEGER, V_LONG, V_SINGLE, V_DOUBLE, V_CURRENCY, V_BIGINT, V_DECIMAL
|
||||
_VarTypeExt = V_NUMERIC
|
||||
Case Else : _VarTypeExt = iType
|
||||
End Select
|
||||
|
||||
End Function ' ScriptForge.SF_Utils._VarTypeExt
|
||||
|
||||
REM ================================================= END OF SCRIPTFORGE.SF_UTILS
|
||||
</script:module>
|
||||
Reference in New Issue
Block a user