2a38a064df
Insert in each service module a pointer to the help page on https://help.libreoffice.org containing the user documentation of the given service. Example: SF_Array.xba contains a pointer to next help page https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_array.html?DbPAR=BASIC Only addition of comments lines. No code change. Change-Id: I83899d9fab247d23e2d5123378e2fb3fd0ade60e Reviewed-on: https://gerrit.libreoffice.org/c/core/+/117370 Tested-by: Jean-Pierre Ledure <jp@ledure.be> Tested-by: Jenkins Reviewed-by: Jean-Pierre Ledure <jp@ledure.be>
2088 lines
No EOL
91 KiB
XML
2088 lines
No EOL
91 KiB
XML
<?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_FileSystem" 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 Compatible
|
|
Option Explicit
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
''' SF_FileSystem
|
|
''' =============
|
|
''' Class implementing the file system service
|
|
''' for common file and folder handling routines
|
|
''' Including copy and move of files and folders, with or without wildcards
|
|
''' The design choices are largely inspired by
|
|
''' https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/filesystemobject-object
|
|
''' The File and Folder classes have been found redundant with the current class and have not been implemented
|
|
''' The implementation is mainly based on the XSimpleFileAccess UNO interface
|
|
''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1ucb_1_1XSimpleFileAccess.html
|
|
'''
|
|
''' Subclasses:
|
|
''' SF_TextStream
|
|
'''
|
|
''' Definitions:
|
|
''' File and folder names may be expressed either in the (preferable because portable) URL form
|
|
''' or in the more usual operating system notation (e.g. C:\... for Windows)
|
|
''' The notation, both for arguments and for returned values
|
|
''' is determined by the FileNaming property: either "URL" (default) or "SYS"
|
|
'''
|
|
''' FileName: the full name of the file including the path without any ending path separator
|
|
''' FolderName: the full name of the folder including the path and the ending path separator
|
|
''' Name: the last component of the File- or FolderName including its extension
|
|
''' BaseName: the last component of the File- or FolderName without its extension
|
|
''' NamePattern: any of the above names containing wildcards in its last component
|
|
''' Admitted wildcards are: the "?" represents any single character
|
|
''' the "*" represents zero, one, or multiple characters
|
|
'''
|
|
''' Service invocation example:
|
|
''' Dim FSO As Variant
|
|
''' Set FSO = CreateScriptService("FileSystem")
|
|
'''
|
|
''' Detailed user documentation:
|
|
''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_filesystem.html?DbPAR=BASIC
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
REM ================================================================== EXCEPTIONS
|
|
|
|
Const UNKNOWNFILEERROR = "UNKNOWNFILEERROR" ' Source file does not exist
|
|
Const UNKNOWNFOLDERERROR = "UNKNOWNFOLDERERROR" ' Source folder or Destination folder does not exist
|
|
Const NOTAFILEERROR = "NOTAFILEERROR" ' Destination is a folder, not a file
|
|
Const NOTAFOLDERERROR = "NOTAFOLDERERROR" ' Destination is a file, not a folder
|
|
Const OVERWRITEERROR = "OVERWRITEERROR" ' Destination can not be overwritten
|
|
Const READONLYERROR = "READONLYERROR" ' Destination has its read-only attribute set
|
|
Const NOFILEMATCHERROR = "NOFILEMATCHFOUND" ' No file matches Source containing wildcards
|
|
Const FOLDERCREATIONERROR = "FOLDERCREATIONERROR" ' FolderName is an existing folder or file
|
|
|
|
REM ============================================================ MODULE CONSTANTS
|
|
|
|
''' TextStream open modes
|
|
Const cstForReading = 1
|
|
Const cstForWriting = 2
|
|
Const cstForAppending = 8
|
|
|
|
REM ===================================================== CONSTRUCTOR/DESTRUCTOR
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Dispose() As Variant
|
|
Set Dispose = Nothing
|
|
End Function ' ScriptForge.SF_FileSystem Explicit destructor
|
|
|
|
REM ================================================================== PROPERTIES
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ConfigFolder() As String
|
|
''' Return the configuration folder of LibreOffice
|
|
|
|
Const cstThisSub = "FileSystem.getConfigFolder"
|
|
|
|
SF_Utils._EnterFunction(cstThisSub)
|
|
ConfigFolder = SF_FileSystem._GetConfigFolder("user")
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
|
|
End Property ' ScriptForge.SF_FileSystem.ConfigFolder
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ExtensionsFolder() As String
|
|
''' Return the folder containing the installed extensions
|
|
|
|
Dim oMacro As Object ' /singletons/com.sun.star.util.theMacroExpander
|
|
Const cstThisSub = "FileSystem.getExtensionsFolder"
|
|
|
|
SF_Utils._EnterFunction(cstThisSub)
|
|
Set oMacro = SF_Utils._GetUNOService("MacroExpander")
|
|
ExtensionsFolder = SF_FileSystem._ConvertFromUrl(oMacro.ExpandMacros("$UNO_USER_PACKAGES_CACHE") & "/")
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
|
|
End Property ' ScriptForge.SF_FileSystem.ExtensionsFolder
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get FileNaming() As Variant
|
|
''' Return the current files and folder notation, either "ANY", "URL" or "SYS"
|
|
''' "ANY": methods receive either URL or native file names, but always return URL file names
|
|
''' "URL": methods expect URL arguments and return URL strings (when relevant)
|
|
''' "SYS": idem but operating system notation
|
|
|
|
Const cstThisSub = "FileSystem.getFileNaming"
|
|
SF_Utils._EnterFunction(cstThisSub)
|
|
FileNaming = _SF_.FileSystemNaming
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
|
|
End Property ' ScriptForge.SF_FileSystem.FileNaming (get)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Let FileNaming(ByVal pvNotation As Variant)
|
|
''' Set the files and folders notation: "ANY", "URL" or "SYS"
|
|
|
|
Const cstThisSub = "FileSystem.setFileNaming"
|
|
SF_Utils._EnterFunction(cstThisSub)
|
|
If VarType(pvNotation) = V_STRING Then
|
|
Select Case UCase(pvNotation)
|
|
Case "ANY", "URL", "SYS" : _SF_.FileSystemNaming = UCase(pvNotation)
|
|
Case Else ' Unchanged
|
|
End Select
|
|
End If
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
|
|
End Property ' ScriptForge.SF_FileSystem.FileNaming (let)
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ForAppending As Integer
|
|
''' Convenient constant (see documentation)
|
|
ForAppending = cstForAppending
|
|
End Property ' ScriptForge.SF_FileSystem.ForAppending
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ForReading As Integer
|
|
''' Convenient constant (see documentation)
|
|
ForReading = cstForReading
|
|
End Property ' ScriptForge.SF_FileSystem.ForReading
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ForWriting As Integer
|
|
''' Convenient constant (see documentation)
|
|
ForWriting = cstForWriting
|
|
End Property ' ScriptForge.SF_FileSystem.ForWriting
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get HomeFolder() As String
|
|
''' Return the user home folder
|
|
|
|
Const cstThisSub = "FileSystem.getHomeFolder"
|
|
|
|
SF_Utils._EnterFunction(cstThisSub)
|
|
HomeFolder = SF_FileSystem._GetConfigFolder("home")
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
|
|
End Property ' ScriptForge.SF_FileSystem.HomeFolder
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get InstallFolder() As String
|
|
''' Return the installation folder of LibreOffice
|
|
|
|
Const cstThisSub = "FileSystem.getInstallFolder"
|
|
|
|
SF_Utils._EnterFunction(cstThisSub)
|
|
InstallFolder = SF_FileSystem._GetConfigFolder("inst")
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
|
|
End Property ' ScriptForge.SF_FileSystem.InstallFolder
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ObjectType As String
|
|
''' Only to enable object representation
|
|
ObjectType = "SF_FileSystem"
|
|
End Property ' ScriptForge.SF_FileSystem.ObjectType
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ServiceName As String
|
|
''' Internal use
|
|
ServiceName = "ScriptForge.FileSystem"
|
|
End Property ' ScriptForge.SF_FileSystem.ServiceName
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get TemplatesFolder() As String
|
|
''' Return the folder defined in the LibreOffice paths options as intended for templates files
|
|
|
|
Dim sPath As String ' Template property of com.sun.star.util.PathSettings
|
|
Const cstThisSub = "FileSystem.getTemplatesFolder"
|
|
|
|
SF_Utils._EnterFunction(cstThisSub)
|
|
sPath = SF_Utils._GetUNOService("PathSettings").Template
|
|
TemplatesFolder = SF_FileSystem._ConvertFromUrl(Split(sPath, ";")(0) & "/")
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
|
|
End Property ' ScriptForge.SF_FileSystem.TemplatesFolder
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get TemporaryFolder() As String
|
|
''' Return the folder defined in the LibreOffice paths options as intended for temporary files
|
|
|
|
Const cstThisSub = "FileSystem.getTemporaryFolder"
|
|
|
|
SF_Utils._EnterFunction(cstThisSub)
|
|
TemporaryFolder = SF_FileSystem._GetConfigFolder("temp")
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
|
|
End Property ' ScriptForge.SF_FileSystem.TemporaryFolder
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get UserTemplatesFolder() As String
|
|
''' Return the folder defined in the LibreOffice paths options as intended for User templates files
|
|
|
|
Dim sPath As String ' Template_writable property of com.sun.star.util.PathSettings
|
|
Const cstThisSub = "FileSystem.getUserTemplatesFolder"
|
|
|
|
SF_Utils._EnterFunction(cstThisSub)
|
|
sPath = SF_Utils._GetUNOService("PathSettings").Template_writable
|
|
UserTemplatesFolder = SF_FileSystem._ConvertFromUrl(sPath & "/")
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
|
|
End Property ' ScriptForge.SF_FileSystem.UserTemplatesFolder
|
|
|
|
REM ===================================================================== METHODS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function BuildPath(Optional ByVal FolderName As Variant _
|
|
, Optional ByVal Name As Variant _
|
|
) As String
|
|
''' Combines a folder path and the name of a file and returns the combination with a valid path separator
|
|
''' Inserts an additional path separator between the foldername and the name, only if necessary
|
|
''' Args:
|
|
''' FolderName: Path with which Name is combined. Path need not specify an existing folder
|
|
''' Name: To be appended to the existing path.
|
|
''' Returns:
|
|
''' The path concatenated with the file name after insertion of a path separator, if necessary
|
|
''' Example:
|
|
''' Dim a As String
|
|
''' FSO.FileNaming = "SYS"
|
|
''' a = FSO.BuildPath("C:\Windows", "Notepad.exe") returns C:\Windows\Notepad.exe
|
|
|
|
Dim sBuild As String ' Return value
|
|
Dim sFile As String ' Alias for Name
|
|
Const cstFileProtocol = "file:///"
|
|
Const cstThisSub = "FileSystem.BuildPath"
|
|
Const cstSubArgs = "FolderName, Name"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sBuild = ""
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(FolderName, "FolderName") Then GoTo Finally
|
|
If Not SF_Utils._Validate(Name, "Name", V_STRING) Then GoTo Finally
|
|
End If
|
|
FolderName = SF_FileSystem._ConvertToUrl(FolderName)
|
|
|
|
Try:
|
|
' Add separator if necessary. FolderName is now in URL notation
|
|
If Len(FolderName) > 0 Then
|
|
If Right(FolderName, 1) <> "/" Then sBuild = FolderName & "/" Else sBuild = FolderName
|
|
Else
|
|
sBuild = cstFileProtocol
|
|
End If
|
|
' Encode the file name
|
|
sFile = ConvertToUrl(Name)
|
|
' Some file names produce http://file.name.suffix/
|
|
If Left(sFile, 7) = "http://" Then sFile = cstFileProtocol & Mid(sFile, 8, Len(sFile) - 8)
|
|
' Combine both parts
|
|
If Left(sFile, Len(cstFileProtocol)) = cstFileProtocol Then sBuild = sBuild & Mid(sFile, Len(cstFileProtocol) + 1) Else sBuild = sBuild & sFile
|
|
|
|
Finally:
|
|
BuildPath = SF_FileSystem._ConvertFromUrl(sBuild)
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.BuildPath
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CompareFiles(Optional ByVal FileName1 As Variant _
|
|
, Optional ByVal FileName2 As Variant _
|
|
, Optional ByVal CompareContents As Variant _
|
|
)
|
|
''' Compare 2 files and return True if they seem identical
|
|
''' The comparison may be based on the file attributes, like modification time,
|
|
''' or on their contents.
|
|
''' Args:
|
|
''' FileName1: The 1st file to compare
|
|
''' FileName2: The 2nd file to compare
|
|
''' CompareContents: When True, the contents of the files are compared. Default = False
|
|
''' Returns:
|
|
''' True when the files seem identical
|
|
''' Exceptions:
|
|
''' UNKNOWNFILEERROR One of the files does not exist
|
|
''' Example:
|
|
''' FSO.FileNaming = "SYS"
|
|
''' MsgBox FSO.CompareFiles("C:\myFile1.txt", "C:\myFile2.txt", CompareContents := True)
|
|
|
|
Dim bCompare As Boolean ' Return value
|
|
Dim sFile As String ' Alias of FileName1 and 2
|
|
Dim iFile As Integer ' 1 or 2
|
|
Const cstPyHelper = "$" & "_SF_FileSystem__CompareFiles"
|
|
|
|
Const cstThisSub = "FileSystem.CompareFiles"
|
|
Const cstSubArgs = "FileName1, FileName2, [CompareContents=False]"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bCompare = False
|
|
|
|
Check:
|
|
If IsMissing(CompareContents) Or IsEmpty(CompareContents) Then CompareContents = False
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(FileName1, "FileName1", False) Then GoTo Finally
|
|
If Not SF_Utils._ValidateFile(FileName2, "FileName2", False) Then GoTo Finally
|
|
If Not SF_Utils._Validate(CompareContents, "CompareContents", V_BOOLEAN) Then GoTo Finally
|
|
End If
|
|
' Do the files exist ? Otherwise raise error
|
|
sFile = FileName1 : iFile = 1
|
|
If Not SF_FileSystem.FileExists(sFile) Then GoTo CatchNotExists
|
|
sFile = FileName2 : iFile = 2
|
|
If Not SF_FileSystem.FileExists(sFile) Then GoTo CatchNotExists
|
|
|
|
Try:
|
|
With ScriptForge.SF_Session
|
|
bCompare = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _
|
|
, _ConvertFromUrl(FileName1) _
|
|
, _ConvertFromUrl(FileName2) _
|
|
, CompareContents)
|
|
End With
|
|
|
|
Finally:
|
|
CompareFiles = bCompare
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchNotExists:
|
|
SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName" & iFile, sFile)
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.CompareFiles
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CopyFile(Optional ByVal Source As Variant _
|
|
, Optional ByVal Destination As Variant _
|
|
, Optional ByVal Overwrite As Variant _
|
|
) As Boolean
|
|
''' Copies one or more files from one location to another
|
|
''' Args:
|
|
''' Source: FileName or NamePattern which can include wildcard characters, for one or more files to be copied
|
|
''' Destination: FileName where the single Source file is to be copied
|
|
''' or FolderName where the multiple files from Source are to be copied
|
|
''' If FolderName does not exist, it is created
|
|
''' Anyway, wildcard characters are not allowed in Destination
|
|
''' Overwrite: If True (default), files may be overwritten
|
|
''' CopyFile will fail if Destination has the read-only attribute set, regardless of the value of Overwrite.
|
|
''' Returns:
|
|
''' True if at least one file has been copied
|
|
''' False if an error occurred
|
|
''' An error also occurs if a source using wildcard characters doesn't match any files.
|
|
''' The method stops on the first error it encounters
|
|
''' No attempt is made to roll back or undo any changes made before an error occurs
|
|
''' Exceptions:
|
|
''' UNKNOWNFILEERROR Source does not exist
|
|
''' UNKNOWNFOLDERERROR Source folder or Destination folder does not exist
|
|
''' NOFILEMATCHERROR No file matches Source containing wildcards
|
|
''' NOTAFOLDERERROR Destination is a file, not a folder
|
|
''' NOTAFILEERROR Destination is a folder, not a file
|
|
''' OVERWRITEERROR Destination can not be overwritten
|
|
''' READONLYERROR Destination has its read-only attribute set
|
|
''' Example:
|
|
''' FSO.FileNaming = "SYS"
|
|
''' FSO.CopyFile("C:\Windows\*.*", "C:\Temp\", Overwrite := False) ' Only files are copied, subfolders are not
|
|
|
|
Dim bCopy As Boolean ' Return value
|
|
|
|
Const cstThisSub = "FileSystem.CopyFile"
|
|
Const cstSubArgs = "Source, Destination, [Overwrite=True]"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bCopy = False
|
|
|
|
Check:
|
|
If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = True
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(Source, "Source", True) Then GoTo Finally
|
|
If Not SF_Utils._ValidateFile(Destination, "Destination", False) Then GoTo Finally
|
|
If Not SF_Utils._Validate(Overwrite, "Overwrite", V_BOOLEAN) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
bCopy = SF_FileSystem._CopyMove("CopyFile", Source, Destination, Overwrite)
|
|
|
|
Finally:
|
|
CopyFile = bCopy
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.CopyFile
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CopyFolder(Optional ByVal Source As Variant _
|
|
, Optional ByVal Destination As Variant _
|
|
, Optional ByVal Overwrite As Variant _
|
|
) As Boolean
|
|
''' Copies one or more folders from one location to another
|
|
''' Args:
|
|
''' Source: FolderName or NamePattern which can include wildcard characters, for one or more folders to be copied
|
|
''' Destination: FolderName where the single Source folder is to be copied
|
|
''' or FolderName where the multiple folders from Source are to be copied
|
|
''' If FolderName does not exist, it is created
|
|
''' Anyway, wildcard characters are not allowed in Destination
|
|
''' Overwrite: If True (default), folders and their content may be overwritten
|
|
''' CopyFile will fail if Destination has the read-only attribute set, regardless of the value of Overwrite.
|
|
''' Returns:
|
|
''' True if at least one folder has been copied
|
|
''' False if an error occurred
|
|
''' An error also occurs if a source using wildcard characters doesn't match any folders.
|
|
''' The method stops on the first error it encounters
|
|
''' No attempt is made to roll back or undo any changes made before an error occurs
|
|
''' Exceptions:
|
|
''' UNKNOWNFILEERROR Source does not exist
|
|
''' UNKNOWNFOLDERERROR Source folder or Destination folder does not exist
|
|
''' NOFILEMATCHERROR No file matches Source containing wildcards
|
|
''' NOTAFOLDERERROR Destination is a file, not a folder
|
|
''' OVERWRITEERROR Destination can not be overwritten
|
|
''' READONLYERROR Destination has its read-only attribute set
|
|
''' Example:
|
|
''' FSO.FileNaming = "SYS"
|
|
''' FSO.CopyFolder("C:\Windows\*", "C:\Temp\", Overwrite := False)
|
|
|
|
Dim bCopy As Boolean ' Return value
|
|
|
|
Const cstThisSub = "FileSystem.CopyFolder"
|
|
Const cstSubArgs = "Source, Destination, [Overwrite=True]"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bCopy = False
|
|
|
|
Check:
|
|
If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = True
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(Source, "Source", True) Then GoTo Finally
|
|
If Not SF_Utils._ValidateFile(Destination, "Destination", False) Then GoTo Finally
|
|
If Not SF_Utils._Validate(Overwrite, "Overwrite", V_BOOLEAN) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
bCopy = SF_FileSystem._CopyMove("CopyFolder", Source, Destination, Overwrite)
|
|
|
|
Finally:
|
|
CopyFolder = bCopy
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.CopyFolder
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateFolder(Optional ByVal FolderName As Variant) As Boolean
|
|
''' Return True if the given folder name could be created successfully
|
|
''' The parent folder does not need to exist beforehand
|
|
''' Args:
|
|
''' FolderName: a string representing the folder to create. It must not exist
|
|
''' Returns:
|
|
''' True if FolderName is a valid folder name, does not exist and creation was successful
|
|
''' False otherwise including when FolderName is a file
|
|
''' Exceptions:
|
|
''' FOLDERCREATIONERROR FolderName is an existing folder or file
|
|
''' Example:
|
|
''' FSO.FileNaming = "SYS"
|
|
''' FSO.CreateFolder("C:\NewFolder\")
|
|
|
|
Dim bCreate As Boolean ' Return value
|
|
Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
|
|
|
|
Const cstThisSub = "FileSystem.CreateFolder"
|
|
Const cstSubArgs = "FolderName"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bCreate = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(FolderName, "FolderName") Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
Set oSfa = SF_Utils._GetUnoService("FileAccess")
|
|
If SF_FileSystem.FolderExists(FolderName) Then GoTo CatchExists
|
|
If SF_FileSystem.FileExists(FolderName) Then GoTo CatchExists
|
|
oSfa.createFolder(SF_FileSystem._ConvertToUrl(FolderName))
|
|
bCreate = True
|
|
|
|
Finally:
|
|
CreateFolder = bCreate
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchExists:
|
|
SF_Exception.RaiseFatal(FOLDERCREATIONERROR, "FolderName", FolderName)
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.CreateFolder
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateTextFile(Optional ByVal FileName As Variant _
|
|
, Optional ByVal Overwrite As Variant _
|
|
, Optional ByVal Encoding As Variant _
|
|
) As Object
|
|
''' Creates a specified file and returns a TextStream object that can be used to write to the file
|
|
''' Args:
|
|
''' FileName: Identifies the file to create
|
|
''' Overwrite: Boolean value that indicates if an existing file can be overwritten (default = True)
|
|
''' Encoding: The character set that should be used
|
|
''' Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml
|
|
''' Note that LibreOffice does not implement all existing sets
|
|
''' Default = UTF-8
|
|
''' Returns:
|
|
''' An instance of the SF_TextStream class representing the opened file or a Null object if an error occurred
|
|
''' It doesn't check either if the given encoding is implemented in LibreOffice
|
|
''' Exceptions:
|
|
''' OVERWRITEERROR File exists, creation impossible
|
|
''' Example:
|
|
''' Dim myFile As Object
|
|
''' FSO.FileNaming = "SYS"
|
|
''' Set myFile = FSO.CreateTextFile("C:\Temp\ThisFile.txt", Overwrite := True)
|
|
|
|
Dim oTextStream As Object ' Return value
|
|
Const cstThisSub = "FileSystem.CreateTextFile"
|
|
Const cstSubArgs = "FileName, [Overwrite=True], [Encoding=""UTF-8""]"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
Set oTextStream = Nothing
|
|
|
|
Check:
|
|
If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = True
|
|
If IsMissing(Encoding) Or IsEmpty(Encoding) Then Encoding = "UTF-8"
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
|
|
If Not SF_Utils._Validate(Overwrite, "Overwrite", V_BOOLEAN) Then GoTo Finally
|
|
If Not SF_Utils._Validate(Encoding, "Encoding", V_STRING) Then GoTo Finally
|
|
End If
|
|
|
|
With SF_FileSystem
|
|
If .FileExists(FileName) Then
|
|
If Overwrite Then .DeleteFile(FileName) Else GoTo CatchOverWrite
|
|
End If
|
|
|
|
Try:
|
|
Set oTextStream = .OpenTextFile(FileName, .ForWriting, Create := True, Encoding := Encoding)
|
|
End With
|
|
|
|
Finally:
|
|
Set CreateTextFile = oTextStream
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchOverWrite:
|
|
SF_Exception.RaiseFatal(OVERWRITEERROR, "FileName", FileName)
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.CreateTextFile
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function DeleteFile(Optional ByVal FileName As Variant) As Boolean
|
|
''' Deletes one or more files
|
|
''' Args:
|
|
''' FileName: FileName or NamePattern which can include wildcard characters, for one or more files to be deleted
|
|
''' Returns:
|
|
''' True if at least one file has been deleted
|
|
''' False if an error occurred
|
|
''' An error also occurs if a FileName using wildcard characters doesn't match any files.
|
|
''' The method stops on the first error it encounters
|
|
''' No attempt is made to roll back or undo any changes made before an error occurs
|
|
''' Exceptions:
|
|
''' UNKNOWNFILEERROR FileName does not exist
|
|
''' NOFILEMATCHERROR No file matches FileName containing wildcards
|
|
''' NOTAFILEERROR Argument is a folder, not a file
|
|
''' Example:
|
|
''' FSO.FileNaming = "SYS"
|
|
''' FSO.DeleteFile("C:\Temp\*.*") ' Only files are deleted, subfolders are not
|
|
|
|
Dim bDelete As Boolean ' Return value
|
|
|
|
Const cstThisSub = "FileSystem.DeleteFile"
|
|
Const cstSubArgs = "FileName"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bDelete = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(FileName, "FileName", True) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
bDelete = SF_FileSystem._Delete("DeleteFile", FileName)
|
|
|
|
Finally:
|
|
DeleteFile = bDelete
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.DeleteFile
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function DeleteFolder(Optional ByVal FolderName As Variant) As Boolean
|
|
''' Deletes one or more Folders
|
|
''' Args:
|
|
''' FolderName: FolderName or NamePattern which can include wildcard characters, for one or more Folders to be deleted
|
|
''' Returns:
|
|
''' True if at least one folder has been deleted
|
|
''' False if an error occurred
|
|
''' An error also occurs if a FolderName using wildcard characters doesn't match any folders.
|
|
''' The method stops on the first error it encounters
|
|
''' No attempt is made to roll back or undo any changes made before an error occurs
|
|
''' Exceptions:
|
|
''' UNKNOWNFOLDERERROR FolderName does not exist
|
|
''' NOFILEMATCHERROR No folder matches FolderName containing wildcards
|
|
''' NOTAFOLDERERROR Argument is a file, not a folder
|
|
''' Example:
|
|
''' FSO.FileNaming = "SYS"
|
|
''' FSO.DeleteFolder("C:\Temp\*") ' Only folders are deleted, files in the parent folder are not
|
|
|
|
Dim bDelete As Boolean ' Return value
|
|
|
|
Const cstThisSub = "FileSystem.DeleteFolder"
|
|
Const cstSubArgs = "FolderName"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bDelete = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(FolderName, "FolderName", True) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
bDelete = SF_FileSystem._Delete("DeleteFolder", FolderName)
|
|
|
|
Finally:
|
|
DeleteFolder = bDelete
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.DeleteFolder
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function FileExists(Optional ByVal FileName As Variant) As Boolean
|
|
''' Return True if the given file exists
|
|
''' Args:
|
|
''' FileName: a string representing a file
|
|
''' Returns:
|
|
''' True if FileName is a valid File name and it exists
|
|
''' False otherwise including when FileName is a folder
|
|
''' Example:
|
|
''' FSO.FileNaming = "SYS"
|
|
''' If FSO.FileExists("C:\Notepad.exe") Then ...
|
|
|
|
Dim bExists As Boolean ' Return value
|
|
Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
|
|
|
|
Const cstThisSub = "FileSystem.FileExists"
|
|
Const cstSubArgs = "FileName"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bExists = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
|
|
End If
|
|
FileName = SF_FileSystem._ConvertToUrl(FileName)
|
|
|
|
Try:
|
|
Set oSfa = SF_Utils._GetUnoService("FileAccess")
|
|
bExists = oSfa.exists(FileName) And Not oSfa.isFolder(FileName)
|
|
|
|
Finally:
|
|
FileExists = bExists
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.FileExists
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Files(Optional ByVal FolderName As Variant _
|
|
, Optional ByVal Filter As Variant _
|
|
) As Variant
|
|
''' Return an array of the FileNames stored in the given folder. The folder must exist
|
|
''' Args:
|
|
''' FolderName: the folder to explore
|
|
''' Filter: contains wildcards ("?" and "*") to limit the list to the relevant files (default = "")
|
|
''' Returns:
|
|
''' An array of strings, each entry is the FileName of an existing file
|
|
''' Exceptions:
|
|
''' UNKNOWNFOLDERERROR Folder does not exist
|
|
''' NOTAFOLDERERROR FolderName is a file, not a folder
|
|
''' Example:
|
|
''' Dim a As Variant
|
|
''' FSO.FileNaming = "SYS"
|
|
''' a = FSO.Files("C:\Windows\")
|
|
|
|
Dim vFiles As Variant ' Return value
|
|
Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
|
|
Dim sFolderName As String ' URL lias for FolderName
|
|
Dim sFile As String ' Single file
|
|
Dim i As Long
|
|
|
|
Const cstThisSub = "FileSystem.Files"
|
|
Const cstSubArgs = "FolderName, [Filter=""""]"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
vFiles = Array()
|
|
|
|
Check:
|
|
If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = ""
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(FolderName, "FolderName") Then GoTo Finally
|
|
If Not SF_Utils._Validate(Filter, "Filter", V_STRING) Then GoTo Finally
|
|
End If
|
|
sFolderName = SF_FileSystem._ConvertToUrl(FolderName)
|
|
If SF_FileSystem.FileExists(FolderName) Then GoTo CatchFile ' Must not be a file
|
|
If Not SF_FileSystem.FolderExists(FolderName) Then GoTo CatchFolder ' Folder must exist
|
|
|
|
Try:
|
|
' Get files
|
|
Set oSfa = SF_Utils._GetUnoService("FileAccess")
|
|
vFiles = oSfa.getFolderContents(sFolderName, False)
|
|
' Adjust notations
|
|
For i = 0 To UBound(vFiles)
|
|
sFile = SF_FileSystem._ConvertFromUrl(vFiles(i))
|
|
vFiles(i) = sFile
|
|
Next i
|
|
' Reduce list to those passing the filter
|
|
If Len(Filter) > 0 Then
|
|
For i = 0 To UBound(vFiles)
|
|
sFile = SF_FileSystem.GetName(vFiles(i))
|
|
If Not SF_String.IsLike(sFile, Filter) Then vFiles(i) = ""
|
|
Next i
|
|
vFiles = Sf_Array.TrimArray(vFiles)
|
|
End If
|
|
|
|
Finally:
|
|
Files = vFiles
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchFile:
|
|
SF_Exception.RaiseFatal(NOTAFOLDERERROR, "FolderName", FolderName)
|
|
GoTo Finally
|
|
CatchFolder:
|
|
SF_Exception.RaiseFatal(UNKNOWNFOLDERERROR, "FolderName", FolderName)
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.Files
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function FolderExists(Optional ByVal FolderName As Variant) As Boolean
|
|
''' Return True if the given folder name exists
|
|
''' Args:
|
|
''' FolderName: a string representing a folder
|
|
''' Returns:
|
|
''' True if FolderName is a valid folder name and it exists
|
|
''' False otherwise including when FolderName is a file
|
|
''' Example:
|
|
''' FSO.FileNaming = "SYS"
|
|
''' If FSO.FolderExists("C:\") Then ...
|
|
|
|
Dim bExists As Boolean ' Return value
|
|
Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
|
|
|
|
Const cstThisSub = "FileSystem.FolderExists"
|
|
Const cstSubArgs = "FolderName"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bExists = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(FolderName, "FolderName") Then GoTo Finally
|
|
End If
|
|
FolderName = SF_FileSystem._ConvertToUrl(FolderName)
|
|
|
|
Try:
|
|
Set oSfa = SF_Utils._GetUnoService("FileAccess")
|
|
bExists = oSfa.isFolder(FolderName)
|
|
|
|
Finally:
|
|
FolderExists = bExists
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.FolderExists
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function GetBaseName(Optional ByVal FileName As Variant) As String
|
|
''' Returns the BaseName part of the last component of a File- or FolderName, without its extension
|
|
''' The method does not check for the existence of the specified file or folder
|
|
''' Args:
|
|
''' FileName: Path and file name
|
|
''' Returns:
|
|
''' The BaseName of the given argument in native operating system format. May be empty
|
|
''' Example:
|
|
''' Dim a As String
|
|
''' FSO.FileNaming = "SYS"
|
|
''' a = FSO.GetBaseName("C:\Windows\Notepad.exe") returns Notepad
|
|
|
|
Dim sBase As String ' Return value
|
|
Dim sExt As String ' Extension
|
|
Dim sName As String ' Last component of FileName
|
|
Dim vName As Variant ' Array of trunks of sName
|
|
Const cstThisSub = "FileSystem.GetBaseName"
|
|
Const cstSubArgs = "FileName"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sBase = ""
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
sName = SF_FileSystem.GetName(FileName)
|
|
If Len(sName) > 0 Then
|
|
If InStr(sName, ".") > 0 Then
|
|
vName = Split(sName, ".")
|
|
sExt = vName(UBound(vName))
|
|
sBase = Left(sName, Len(sName) - Len(sExt) - 1)
|
|
Else
|
|
sBase = sName
|
|
End If
|
|
End If
|
|
|
|
Finally:
|
|
GetBaseName = sBase
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.GetBaseName
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function GetExtension(Optional ByVal FileName As Variant) As String
|
|
''' Returns the extension part of a File- or FolderName, without the dot (.).
|
|
''' The method does not check for the existence of the specified file or folder
|
|
''' Args:
|
|
''' FileName: Path and file name
|
|
''' Returns:
|
|
''' The extension without a leading dot. May be empty
|
|
''' Example:
|
|
''' Dim a As String
|
|
''' FSO.FileNaming = "SYS"
|
|
''' a = FSO.GetExtension("C:\Windows\Notepad.exe") returns exe
|
|
|
|
Dim sExt As String ' Return value
|
|
Dim sName As String ' Last component of FileName
|
|
Dim vName As Variant ' Array of trunks of sName
|
|
Const cstThisSub = "FileSystem.GetExtension"
|
|
Const cstSubArgs = "FileName"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sExt = ""
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
sName = SF_FileSystem.GetName(FileName)
|
|
If Len(sName) > 0 And InStr(sName, ".") > 0 Then
|
|
vName = Split(sName, ".")
|
|
sExt = vName(UBound(vName))
|
|
End If
|
|
|
|
Finally:
|
|
GetExtension = sExt
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.GetExtension
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function GetFileLen(Optional ByVal FileName As Variant) As Currency
|
|
''' Return file size in bytes with four decimals '''
|
|
''' Args:
|
|
''' FileName: a string representing a file
|
|
''' Returns:
|
|
''' File size if FileName exists
|
|
''' Exceptions:
|
|
''' UNKNOWNFILEERROR The file does not exist of is a folder
|
|
''' Example:
|
|
''' Print SF_FileSystem.GetFileLen("C:\pagefile.sys")
|
|
|
|
Dim curSize As Currency ' Return value
|
|
Const cstPyHelper = "$" & "_SF_FileSystem__GetFilelen"
|
|
Const cstThisSub = "FileSystem.GetFileLen"
|
|
Const cstSubArgs = "FileName"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
curSize = 0
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
If SF_FileSystem.FileExists(FileName) Then
|
|
With ScriptForge.SF_Session
|
|
curSize = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _
|
|
, _ConvertFromUrl(FileName))
|
|
End With
|
|
Else
|
|
GoTo CatchNotExists
|
|
End If
|
|
|
|
Finally:
|
|
GetFileLen = curSize
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchNotExists:
|
|
SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", FileName)
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.GetFileLen
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function GetFileModified(Optional ByVal FileName As Variant) As Variant
|
|
''' Returns the last modified date for the given file
|
|
''' Args:
|
|
''' FileName: a string representing an existing file
|
|
''' Returns:
|
|
''' The modification date and time as a Basic Date
|
|
''' Exceptions:
|
|
''' UNKNOWNFILEERROR The file does not exist of is a folder
|
|
''' Example:
|
|
''' Dim a As Date
|
|
''' FSO.FileNaming = "SYS"
|
|
''' a = FSO.GetFileModified("C:\Temp\myDoc.odt")
|
|
|
|
Dim dModified As Date ' Return value
|
|
Dim oModified As New com.sun.star.util.DateTime
|
|
Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
|
|
|
|
Const cstThisSub = "FileSystem.GetFileModified"
|
|
Const cstSubArgs = "FileName"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
dModified = 0
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
Set oSfa = SF_Utils._GetUnoService("FileAccess")
|
|
If SF_FileSystem.FileExists(FileName) Then
|
|
FileName = SF_FileSystem._ConvertToUrl(FileName)
|
|
Set oModified = oSfa.getDateTimeModified(FileName)
|
|
dModified = CDateFromUnoDateTime(oModified)
|
|
Else
|
|
GoTo CatchNotExists
|
|
End If
|
|
|
|
Finally:
|
|
GetFileModified = dModified
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchNotExists:
|
|
SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", FileName)
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.GetFileModified
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function GetName(Optional ByVal FileName As Variant) As String
|
|
''' Returns the last component of a File- or FolderName
|
|
''' The method does not check for the existence of the specified file or folder
|
|
''' Args:
|
|
''' FileName: Path and file name
|
|
''' Returns:
|
|
''' The last component of the full file name in native operating system format
|
|
''' Example:
|
|
''' Dim a As String
|
|
''' FSO.FileNaming = "SYS"
|
|
''' a = FSO.GetName("C:\Windows\Notepad.exe") returns Notepad.exe
|
|
|
|
Dim sName As String ' Return value
|
|
Dim vFile As Variant ' Array of components
|
|
Const cstThisSub = "FileSystem.GetName"
|
|
Const cstSubArgs = "FileName"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sName = ""
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
|
|
End If
|
|
FileName = SF_FileSystem._ConvertToUrl(FileName)
|
|
|
|
Try:
|
|
If Len(FileName) > 0 Then
|
|
If Right(FileName, 1) = "/" Then FileName = Left(FileName, Len(FileName) - 1)
|
|
vFile = Split(FileName, "/")
|
|
sName = ConvertFromUrl(vFile(UBound(vFile))) ' Always in SYS format
|
|
End If
|
|
|
|
Finally:
|
|
GetName = sName
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.GetName
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function GetParentFolderName(Optional ByVal FileName As Variant) As String
|
|
''' Returns a string containing the name of the parent folder of the last component in a specified File- or FolderName
|
|
''' The method does not check for the existence of the specified file or folder
|
|
''' Args:
|
|
''' FileName: Path and file name
|
|
''' Returns:
|
|
''' A FolderName including its final path separator
|
|
''' Example:
|
|
''' Dim a As String
|
|
''' FSO.FileNaming = "SYS"
|
|
''' a = FSO.GetParentFolderName("C:\Windows\Notepad.exe") returns C:\Windows\
|
|
|
|
Dim sFolder As String ' Return value
|
|
Dim sName As String ' Last component of FileName
|
|
Dim vFile As Variant ' Array of file components
|
|
Const cstThisSub = "FileSystem.GetParentFolderName"
|
|
Const cstSubArgs = "FileName"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sFolder = ""
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
|
|
End If
|
|
FileName = SF_FileSystem._ConvertToUrl(FileName)
|
|
|
|
Try:
|
|
If Right(FileName, 1) = "/" Then FileName = Left(FileName, Len(FileName) - 1)
|
|
vFile = Split(FileName, "/")
|
|
If UBound(vFile) >= 0 Then vFile(UBound(vFile)) = ""
|
|
sFolder = Join(vFile, "/")
|
|
If sFolder = "" Or Right(sFolder, 1) <> "/" Then sFolder = sFolder & "/"
|
|
|
|
Finally:
|
|
GetParentFolderName = SF_FileSystem._ConvertFromUrl(sFolder)
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.GetParentFolderName
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
|
|
''' Return the actual value of the given property
|
|
''' Args:
|
|
''' PropertyName: the name of the property as a string
|
|
''' Returns:
|
|
''' The actual value of the property
|
|
''' Exceptions
|
|
''' ARGUMENTERROR The property does not exist
|
|
|
|
Const cstThisSub = "FileSystem.GetProperty"
|
|
Const cstSubArgs = "PropertyName"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
GetProperty = Null
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
|
|
End If
|
|
|
|
Try:
|
|
Select Case UCase(PropertyName)
|
|
Case UCase("ConfigFolder") : GetProperty = ConfigFolder
|
|
Case UCase("ExtensionsFolder") : GetProperty = ExtensionsFolder
|
|
Case UCase("FileNaming") : GetProperty = FileNaming
|
|
Case UCase("HomeFolder") : GetProperty = HomeFolder
|
|
Case UCase("InstallFolder") : GetProperty = InstallFolder
|
|
Case UCase("TemplatesFolder") : GetProperty = TemplatesFolder
|
|
Case UCase("TemporaryFolder") : GetProperty = TemporaryFolder
|
|
Case UCase("UserTemplatesFolder") : GetProperty = UserTemplatesFolder
|
|
Case Else
|
|
End Select
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.GetProperty
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function GetTempName() As String
|
|
''' Returns a randomly generated temporary file name that is useful for performing
|
|
''' operations that require a temporary file : the method does not create any file
|
|
''' Args:
|
|
''' Returns:
|
|
''' A FileName as a String that can be used f.i. with CreateTextFile()
|
|
''' The FileName does not have any suffix
|
|
''' Example:
|
|
''' Dim a As String
|
|
''' FSO.FileNaming = "SYS"
|
|
''' a = FSO.GetTempName() & ".txt"
|
|
|
|
Dim sFile As String ' Return value
|
|
Dim sTempDir As String ' The path to a temporary folder
|
|
Dim lRandom As Long ' Random integer
|
|
|
|
Const cstThisSub = "FileSystem.GetTempName"
|
|
Const cstSubArgs = ""
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sFile = ""
|
|
|
|
Check:
|
|
SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
|
|
|
Try:
|
|
lRandom = SF_Session.ExecuteCalcFunction("RANDBETWEEN", 1, 999999)
|
|
sFile = SF_FileSystem.TemporaryFolder & "SF_" & Right("000000" & lRandom, 6)
|
|
|
|
Finally:
|
|
GetTempName = SF_FileSystem._ConvertFromUrl(sFile)
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.GetTempName
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function HashFile(Optional ByVal FileName As Variant _
|
|
, Optional ByVal Algorithm As Variant _
|
|
) As String
|
|
''' Return an hexadecimal string representing a checksum of the given file
|
|
''' Next algorithms are supported: MD5, SHA1, SHA224, SHA256, SHA384 and SHA512
|
|
''' Args:
|
|
''' FileName: a string representing a file
|
|
''' Algorithm: The hashing algorithm to use
|
|
''' Returns:
|
|
''' The requested checksum as a string. Hexadecimal digits are lower-cased
|
|
''' A zero-length string when an error occurred
|
|
''' Exceptions:
|
|
''' UNKNOWNFILEERROR The file does not exist of is a folder
|
|
''' Example:
|
|
''' Print SF_FileSystem.HashFile("C:\pagefile.sys", "MD5")
|
|
|
|
Dim sHash As String ' Return value
|
|
Const cstPyHelper = "$" & "_SF_FileSystem__HashFile"
|
|
Const cstThisSub = "FileSystem.HashFile"
|
|
Const cstSubArgs = "FileName, Algorithm=""MD5""|""SHA1""|""SHA224""|""SHA256""|""SHA384""|""SHA512"""
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sHash = ""
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
|
|
If Not SF_Utils._Validate(Algorithm, "Algorithm", V_STRING _
|
|
, Array("MD5", "SHA1", "SHA224", "SHA256", "SHA384", "SHA512")) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
If SF_FileSystem.FileExists(FileName) Then
|
|
With ScriptForge.SF_Session
|
|
sHash = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _
|
|
, _ConvertFromUrl(FileName), LCase(Algorithm))
|
|
End With
|
|
Else
|
|
GoTo CatchNotExists
|
|
End If
|
|
|
|
Finally:
|
|
HashFile = sHash
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchNotExists:
|
|
SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", FileName)
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.HashFile
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Methods() As Variant
|
|
''' Return the list or methods of the FileSystem service as an array
|
|
|
|
Methods = Array("BuildPath" _
|
|
, "CompareFiles" _
|
|
, "CopyFile" _
|
|
, "CopyFolder" _
|
|
, "CreateFolder" _
|
|
, "CreateTextFile" _
|
|
, "DeleteFile" _
|
|
, "DeleteFolder" _
|
|
, "FileExists" _
|
|
, "Files" _
|
|
, "FolderExists" _
|
|
, "GetBaseName" _
|
|
, "GetExtension" _
|
|
, "GetFileLen" _
|
|
, "GetFileModified" _
|
|
, "GetName" _
|
|
, "GetParentFolderName" _
|
|
, "GetTempName" _
|
|
, "HashFile" _
|
|
, "MoveFile" _
|
|
, "MoveFolder" _
|
|
, "OpenTextFile" _
|
|
, "PickFile" _
|
|
, "PickFolder" _
|
|
, "SubFolders" _
|
|
)
|
|
|
|
End Function ' ScriptForge.SF_FileSystem.Methods
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function MoveFile(Optional ByVal Source As Variant _
|
|
, Optional ByVal Destination As Variant _
|
|
) As Boolean
|
|
''' Moves one or more files from one location to another
|
|
''' Args:
|
|
''' Source: FileName or NamePattern which can include wildcard characters, for one or more files to be moved
|
|
''' Destination: FileName where the single Source file is to be moved
|
|
''' If Source and Destination have the same parent folder MoveFile amounts to renaming the Source
|
|
''' or FolderName where the multiple files from Source are to be moved
|
|
''' If FolderName does not exist, it is created
|
|
''' Anyway, wildcard characters are not allowed in Destination
|
|
''' Returns:
|
|
''' True if at least one file has been moved
|
|
''' False if an error occurred
|
|
''' An error also occurs if a source using wildcard characters doesn't match any files.
|
|
''' The method stops on the first error it encounters
|
|
''' No attempt is made to roll back or undo any changes made before an error occurs
|
|
''' Exceptions:
|
|
''' UNKNOWNFILEERROR Source does not exist
|
|
''' UNKNOWNFOLDERERROR Source folder or Destination folder does not exist
|
|
''' NOFILEMATCHERROR No file matches Source containing wildcards
|
|
''' NOTAFOLDERERROR Destination is a file, not a folder
|
|
''' NOTAFILEERROR Destination is a folder, not a file
|
|
''' OVERWRITEERROR Destination can not be overwritten
|
|
''' Example:
|
|
''' FSO.FileNaming = "SYS"
|
|
''' FSO.MoveFile("C:\Temp1\*.*", "C:\Temp2\") ' Only files are moved, subfolders are not
|
|
|
|
Dim bMove As Boolean ' Return value
|
|
|
|
Const cstThisSub = "FileSystem.MoveFile"
|
|
Const cstSubArgs = "Source, Destination"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bMove = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(Source, "Source", True) Then GoTo Finally
|
|
If Not SF_Utils._ValidateFile(Destination, "Destination", False) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
bMove = SF_FileSystem._CopyMove("MoveFile", Source, Destination, False)
|
|
|
|
Finally:
|
|
MoveFile = bMove
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.MoveFile
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function MoveFolder(Optional ByVal Source As Variant _
|
|
, Optional ByVal Destination As Variant _
|
|
) As Boolean
|
|
''' Moves one or more folders from one location to another
|
|
''' Args:
|
|
''' Source: FolderName or NamePattern which can include wildcard characters, for one or more folders to be moved
|
|
''' Destination: FolderName where the single Source folder is to be moved
|
|
''' FolderName must not exist
|
|
''' or FolderName where the multiple folders from Source are to be moved
|
|
''' If FolderName does not exist, it is created
|
|
''' Anyway, wildcard characters are not allowed in Destination
|
|
''' Returns:
|
|
''' True if at least one folder has been moved
|
|
''' False if an error occurred
|
|
''' An error also occurs if a source using wildcard characters doesn't match any folders.
|
|
''' The method stops on the first error it encounters
|
|
''' No attempt is made to roll back or undo any changes made before an error occurs
|
|
''' Exceptions:
|
|
''' UNKNOWNFILEERROR Source does not exist
|
|
''' UNKNOWNFOLDERERROR Source folder or Destination folder does not exist
|
|
''' NOFILEMATCHERROR No file matches Source containing wildcards
|
|
''' NOTAFOLDERERROR Destination is a file, not a folder
|
|
''' OVERWRITEERROR Destination can not be overwritten
|
|
''' Example:
|
|
''' FSO.FileNaming = "SYS"
|
|
''' FSO.MoveFolder("C:\Temp1\*", "C:\Temp2\")
|
|
|
|
Dim bMove As Boolean ' Return value
|
|
|
|
Const cstThisSub = "FileSystem.MoveFolder"
|
|
Const cstSubArgs = "Source, Destination"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bMove = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(Source, "Source", True) Then GoTo Finally
|
|
If Not SF_Utils._ValidateFile(Destination, "Destination", False) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
bMove = SF_FileSystem._CopyMove("MoveFolder", Source, Destination, False)
|
|
|
|
Finally:
|
|
MoveFolder = bMove
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.MoveFolder
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function OpenTextFile(Optional ByVal FileName As Variant _
|
|
, Optional ByVal IOMode As Variant _
|
|
, Optional ByVal Create As Variant _
|
|
, Optional ByVal Encoding As Variant _
|
|
) As Object
|
|
''' Opens a specified file and returns a TextStream object that can be used to read from, write to, or append to the file
|
|
''' Args:
|
|
''' FileName: Identifies the file to open
|
|
''' IOMode: Indicates input/output mode. Can be one of three constants: ForReading, ForWriting, or ForAppending
|
|
''' Create: Boolean value that indicates whether a new file can be created if the specified filename doesn't exist.
|
|
''' The value is True if a new file and its parent folders may be created; False if they aren't created (default)
|
|
''' Encoding: The character set that should be used
|
|
''' Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml
|
|
''' Note that LibreOffice does not implement all existing sets
|
|
''' Default = UTF-8
|
|
''' Returns:
|
|
''' An instance of the SF_TextStream class representing the opened file or a Null object if an error occurred
|
|
''' The method does not check if the file is really a text file
|
|
''' It doesn't check either if the given encoding is implemented in LibreOffice nor if it is the right one
|
|
''' Exceptions:
|
|
''' UNKNOWNFILEERROR File does not exist
|
|
''' Example:
|
|
''' Dim myFile As Object
|
|
''' FSO.FileNaming = "SYS"
|
|
''' Set myFile = FSO.OpenTextFile("C:\Temp\ThisFile.txt", FSO.ForReading)
|
|
''' If Not IsNull(myFile) Then ' ... Go ahead with reading text lines
|
|
|
|
Dim oTextStream As Object ' Return value
|
|
Dim bExists As Boolean ' File to open does exist
|
|
Const cstThisSub = "FileSystem.OpenTextFile"
|
|
Const cstSubArgs = "FileName, [IOMode=1], [Create=False], [Encoding=""UTF-8""]"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
Set oTextStream = Nothing
|
|
|
|
Check:
|
|
With SF_FileSystem
|
|
If IsMissing(IOMode) Or IsEmpty(IOMode) Then IOMode = ForReading
|
|
If IsMissing(Create) Or IsEmpty(Create) Then Create = False
|
|
If IsMissing(Encoding) Or IsEmpty(Encoding) Then Encoding = "UTF-8"
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
|
|
If Not SF_Utils._Validate(IOMode, "IOMode", V_NUMERIC _
|
|
, Array(ForReading, ForWriting, ForAppending)) _
|
|
Then GoTo Finally
|
|
If Not SF_Utils._Validate(Create, "Create", V_BOOLEAN) Then GoTo Finally
|
|
If Not SF_Utils._Validate(Encoding, "Encoding", V_STRING) Then GoTo Finally
|
|
End If
|
|
|
|
bExists = .FileExists(FileName)
|
|
Select Case IOMode
|
|
Case ForReading : If Not bExists Then GoTo CatchNotExists
|
|
Case Else : If Not bExists And Not Create Then GoTo CatchNotExists
|
|
End Select
|
|
|
|
If IOMode = ForAppending And Not bExists Then IOMode = ForWriting
|
|
End With
|
|
|
|
Try:
|
|
' Create and initialize TextStream class instance
|
|
Set oTextStream = New SF_TextStream
|
|
With oTextStream
|
|
.[Me] = oTextStream
|
|
.[_Parent] = SF_FileSystem
|
|
._FileName = SF_FileSystem._ConvertToUrl(FileName)
|
|
._IOMode = IOMode
|
|
._Encoding = Encoding
|
|
._FileExists = bExists
|
|
._Initialize()
|
|
End With
|
|
|
|
Finally:
|
|
Set OpenTextFile = oTextStream
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchNotExists:
|
|
SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", FileName)
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.OpenTextFile
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function PickFile(Optional ByVal DefaultFile As Variant _
|
|
, Optional ByVal Mode As Variant _
|
|
, Optional ByVal Filter As Variant _
|
|
) As String
|
|
''' Returns the file selected with a FilePicker dialog box
|
|
''' The mode, OPEN or SAVE, and the filter may be preset
|
|
''' If mode = SAVE and the picked file exists, a warning message will be displayed
|
|
''' Modified from Andrew Pitonyak's Base Macro Programming §10.4
|
|
''' Args:
|
|
''' DefaultFile: Folder part: the FolderName from which to start. Default = the last selected folder
|
|
''' File part: the default file to open or save
|
|
''' Mode: "OPEN" (input file) or "SAVE" (output file)
|
|
''' Filter: by default only files having the given suffix will be displayed. Default = all suffixes
|
|
''' The filter combo box will contain the given SuffixFilter (if not "*") and "*.*"
|
|
''' Returns:
|
|
''' The selected FileName in URL format or "" if the dialog was cancelled
|
|
''' Example:
|
|
''' FSO.FileNaming = "SYS"
|
|
''' FSO.PickFile("C:\", "OPEN", "txt") ' Only *.txt files are displayed
|
|
|
|
Dim oFileDialog As Object ' com.sun.star.ui.dialogs.FilePicker
|
|
Dim oFileAccess As object ' com.sun.star.ucb.SimpleFileAccess
|
|
Dim oPath As Object ' com.sun.star.util.PathSettings
|
|
Dim iAccept As Integer ' Result of dialog execution
|
|
Dim sInitPath As String ' Current working directory
|
|
Dim sBaseFile As String
|
|
Dim iMode As Integer ' Numeric alias for SelectMode
|
|
Dim sFile As String ' Return value
|
|
|
|
Const cstThisSub = "FileSystem.PickFile"
|
|
Const cstSubArgs = "[DefaultFile=""""], [Mode=""OPEN""|""SAVE""],[Filter=""""]"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sFile = ""
|
|
|
|
Check:
|
|
If IsMissing(DefaultFile) Or IsEmpty(DefaultFile) Then DefaultFile = ""
|
|
If IsMissing(Mode) Or IsEmpty(Mode) Then Mode = "OPEN"
|
|
If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = ""
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(DefaultFile, "DefaultFile", , True) Then GoTo Finally
|
|
If Not SF_Utils._Validate(Mode, "Mode", V_STRING, Array("OPEN", "SAVE")) Then GoTo Finally
|
|
If Not SF_Utils._Validate(Filter, "Filter", V_STRING) Then GoTo Finally
|
|
End If
|
|
DefaultFile = SF_FileSystem._ConvertToUrl(DefaultFile)
|
|
|
|
Try:
|
|
' Derive numeric equivalent of the Mode argument: https://api.libreoffice.org/docs/idl/ref/TemplateDescription_8idl.html
|
|
With com.sun.star.ui.dialogs.TemplateDescription
|
|
If Mode = "OPEN" Then iMode = .FILEOPEN_SIMPLE Else iMode = .FILESAVE_AUTOEXTENSION
|
|
End With
|
|
|
|
' Activate the filepicker dialog
|
|
Set oFileDialog = SF_Utils._GetUNOService("FilePicker")
|
|
With oFileDialog
|
|
.Initialize(Array(iMode))
|
|
|
|
' Set filters
|
|
If Len(Filter) > 0 Then .appendFilter("*." & Filter, "*." & Filter) ' Twice: required by API
|
|
.appendFilter("*.*", "*.*")
|
|
If Len(Filter) > 0 Then .setCurrentFilter("*." & Filter) Else .setCurrentFilter("*.*")
|
|
|
|
' Set initial folder
|
|
If Len(DefaultFile) = 0 Then ' TODO: SF_Session.WorkingFolder
|
|
Set oPath = SF_Utils._GetUNOService("PathSettings")
|
|
sInitPath = oPath.Work ' Probably My Documents
|
|
Else
|
|
sInitPath = SF_FileSystem._ParseUrl(ConvertToUrl(DefaultFile)).Path
|
|
End If
|
|
|
|
' Set default values
|
|
Set oFileAccess = SF_Utils._GetUNOService("FileAccess")
|
|
If oFileAccess.exists(sInitPath) Then .SetDisplayDirectory(sInitPath)
|
|
sBaseFile = SF_FileSystem.GetName(DefaultFile)
|
|
.setDefaultName(sBaseFile)
|
|
|
|
' Get selected file
|
|
iAccept = .Execute()
|
|
If iAccept = com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then sFile = .getSelectedFiles()(0)
|
|
End With
|
|
|
|
Finally:
|
|
PickFile = SF_FileSystem._ConvertFromUrl(sFile)
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.PickFile
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function PickFolder(Optional ByVal DefaultFolder As variant _
|
|
, Optional ByVal FreeText As Variant _
|
|
) As String
|
|
''' Display a FolderPicker dialog box
|
|
''' Args:
|
|
''' DefaultFolder: the FolderName from which to start. Default = the last selected folder
|
|
''' FreeText: text to display in the dialog. Default = ""
|
|
''' Returns:
|
|
''' The selected FolderName in URL or operating system format
|
|
''' The zero-length string if the dialog was cancelled
|
|
''' Example:
|
|
''' FSO.FileNaming = "SYS"
|
|
''' FSO.PickFolder("C:\", "Choose a folder or press Cancel")
|
|
|
|
Dim oFolderDialog As Object ' com.sun.star.ui.dialogs.FolderPicker
|
|
Dim iAccept As Integer ' Value returned by the dialog (OK, Cancel, ..)
|
|
Dim sFolder As String ' Return value '
|
|
|
|
Const cstThisSub = "FileSystem.PickFolder"
|
|
Const cstSubArgs = "[DefaultFolder=""""], [FreeText=""""]"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sFolder = ""
|
|
|
|
Check:
|
|
If IsMissing(DefaultFolder) Or IsEmpty(DefaultFolder) Then DefaultFolder = ""
|
|
If IsMissing(FreeText) Or IsEmpty(FreeText) Then FreeText = ""
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(DefaultFolder, "DefaultFolder", , True) Then GoTo Finally
|
|
If Not SF_Utils._Validate(FreeText, "FreeText", V_STRING) Then GoTo Finally
|
|
End If
|
|
DefaultFolder = SF_FileSystem._ConvertToUrl(DefaultFolder)
|
|
|
|
Try:
|
|
Set oFolderDialog = SF_Utils._GetUNOService("FolderPicker")
|
|
If Not IsNull(oFolderDialog) Then
|
|
With oFolderDialog
|
|
If Len(DefaultFolder) > 0 Then .DisplayDirectory = ConvertToUrl(DefaultFolder)
|
|
.Description = FreeText
|
|
iAccept = .Execute()
|
|
' https://api.libreoffice.org/docs/idl/ref/ExecutableDialogResults_8idl.html
|
|
If iAccept = com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then
|
|
.DisplayDirectory = .Directory ' Set the next default initial folder to the selected one
|
|
sFolder = .Directory & "/"
|
|
End If
|
|
End With
|
|
End If
|
|
|
|
Finally:
|
|
PickFolder = SF_FileSystem._ConvertFromUrl(sFolder)
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.PickFolder
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Properties() As Variant
|
|
''' Return the list or properties of the FileSystem module as an array
|
|
|
|
Properties = Array( _
|
|
"ConfigFolder" _
|
|
, "ExtensionsFolder" _
|
|
, "FileNaming" _
|
|
, "HomeFolder" _
|
|
, "InstallFolder" _
|
|
, "TemplatesFolder" _
|
|
, "TemporaryFolder" _
|
|
, "UserTemplatesFolder" _
|
|
)
|
|
|
|
End Function ' ScriptForge.SF_FileSystem.Properties
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function SetProperty(Optional ByVal PropertyName As Variant _
|
|
, Optional ByRef Value As Variant _
|
|
) As Boolean
|
|
''' Set a new value to the given property
|
|
''' Args:
|
|
''' PropertyName: the name of the property as a string
|
|
''' Value: its new value
|
|
''' Exceptions
|
|
''' ARGUMENTERROR The property does not exist
|
|
|
|
Const cstThisSub = "FileSystem.SetProperty"
|
|
Const cstSubArgs = "PropertyName, Value"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
SetProperty = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
|
|
End If
|
|
|
|
Try:
|
|
Select Case UCase(PropertyName)
|
|
Case UCase("FileNaming") : FileNaming = Value
|
|
Case Else
|
|
End Select
|
|
|
|
Finally:
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.SetProperty
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function SubFolders(Optional ByVal FolderName As Variant _
|
|
, Optional ByVal Filter As Variant _
|
|
) As Variant
|
|
''' Return an array of the FolderNames stored in the given folder. The folder must exist
|
|
''' Args:
|
|
''' FolderName: the folder to explore
|
|
''' Filter: contains wildcards ("?" and "*") to limit the list to the relevant folders (default = "")
|
|
''' Returns:
|
|
''' An array of strings, each entry is the FolderName of an existing folder
|
|
''' Exceptions:
|
|
''' UNKNOWNFOLDERERROR Folder does not exist
|
|
''' NOTAFOLDERERROR FolderName is a file, not a folder
|
|
''' Example:
|
|
''' Dim a As Variant
|
|
''' FSO.FileNaming = "SYS"
|
|
''' a = FSO.SubFolders("C:\Windows\")
|
|
|
|
Dim vSubFolders As Variant ' Return value
|
|
Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
|
|
Dim sFolderName As String ' URL lias for FolderName
|
|
Dim sFolder As String ' Single folder
|
|
Dim i As Long
|
|
|
|
Const cstThisSub = "FileSystem.SubFolders"
|
|
Const cstSubArgs = "FolderName, [Filter=""""]"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
vSubFolders = Array()
|
|
|
|
Check:
|
|
If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = ""
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(FolderName, "FolderName") Then GoTo Finally
|
|
If Not SF_Utils._Validate(Filter, "Filter", V_STRING) Then GoTo Finally
|
|
End If
|
|
sFolderName = SF_FileSystem._ConvertToUrl(FolderName)
|
|
If SF_FileSystem.FileExists(FolderName) Then GoTo CatchFile ' Must not be a file
|
|
If Not SF_FileSystem.FolderExists(FolderName) Then GoTo CatchFolder ' Folder must exist
|
|
|
|
Try:
|
|
' Get SubFolders
|
|
Set oSfa = SF_Utils._GetUnoService("FileAccess")
|
|
vSubFolders = oSfa.getFolderContents(sFolderName, True)
|
|
' List includes files; remove them or adjust notations of folders
|
|
For i = 0 To UBound(vSubFolders)
|
|
sFolder = SF_FileSystem._ConvertFromUrl(vSubFolders(i) & "/")
|
|
If SF_FileSystem.FileExists(sFolder) Then vSubFolders(i) = "" Else vSubFolders(i) = sFolder
|
|
' Reduce list to those passing the filter
|
|
If Len(Filter) > 0 And Len(vSubFolders(i)) > 0 Then
|
|
sFolder = SF_FileSystem.GetName(vSubFolders(i))
|
|
If Not SF_String.IsLike(sFolder, Filter) Then vSubFolders(i) = ""
|
|
End If
|
|
Next i
|
|
vSubFolders = SF_Array.TrimArray(vSubFolders)
|
|
|
|
Finally:
|
|
SubFolders = vSubFolders
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchFile:
|
|
SF_Exception.RaiseFatal(NOTAFOLDERERROR, "FolderName", FolderName)
|
|
GoTo Finally
|
|
CatchFolder:
|
|
SF_Exception.RaiseFatal(UNKNOWNFOLDERERROR, "FolderName", FolderName)
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.SubFolders
|
|
|
|
REM =========================================================== PRIVATE FUNCTIONS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _ConvertFromUrl(psFile) As String
|
|
''' Execute the builtin ConvertFromUrl function only when relevant
|
|
''' i.e. when FileNaming (how arguments and return values are provided) = "SYS"
|
|
''' Called at the bottom of methods returning file names
|
|
''' Remark: psFile might contain wildcards
|
|
|
|
Const cstQuestion = "$QUESTION$", cstStar = "$STAR$" ' Special tokens to replace wildcards
|
|
|
|
If SF_FileSystem.FileNaming = "SYS" Then
|
|
_ConvertFromUrl = Replace(Replace( _
|
|
ConvertFromUrl(Replace(Replace(psFile, "?", cstQuestion), "*", cstStar)) _
|
|
, cstQuestion, "?"), cstStar, "*")
|
|
Else
|
|
_ConvertFromUrl = psFile
|
|
End If
|
|
|
|
End Function ' ScriptForge.FileSystem._ConvertFromUrl
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _ConvertToUrl(psFile) As String
|
|
''' Execute the builtin ConvertToUrl function only when relevant
|
|
''' i.e. when FileNaming (how arguments and return values are provided) = "SYS"
|
|
''' Called at the top of methods receiving file names as arguments
|
|
''' Remark: psFile might contain wildcards
|
|
|
|
If SF_FileSystem.FileNaming = "URL" Then
|
|
_ConvertToUrl = psFile
|
|
Else
|
|
' ConvertToUrl encodes "?"
|
|
_ConvertToUrl = Replace(ConvertToUrl(psFile), "%3F", "?")
|
|
End If
|
|
|
|
End Function ' ScriptForge.FileSystem._ConvertToUrl
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _CopyMove(psMethod As String _
|
|
, psSource As String _
|
|
, psDestination As String _
|
|
, pbOverWrite As Boolean _
|
|
) As Boolean
|
|
''' Checks the arguments and executes the given method
|
|
''' Args:
|
|
''' psMethod: CopyFile/CopyFolder or MoveFile/MoveFolder
|
|
''' psSource: Either File/FolderName
|
|
''' or NamePattern which can include wildcard characters, for one or more files/folders to be copied
|
|
''' psDestination: FileName or FolderName for copy/move of a single file/folder
|
|
''' Otherwise a destination FolderName. If it does not exist, it is created
|
|
''' pbOverWrite: If True, files/folders may be overwritten
|
|
''' Must be False for Move operations
|
|
''' Next checks are done:
|
|
''' With wildcards (multiple files/folders):
|
|
''' - Parent folder of source must exist
|
|
''' - Destination must not be a file
|
|
''' - Parent folder of Destination must exist
|
|
''' - If the Destination folder does not exist a new folder is created,
|
|
''' - At least one file matches the wildcards expression
|
|
''' - Destination files/folder must not exist if pbOverWrite = False
|
|
''' - Destination files/folders must not have the read-only attribute set
|
|
''' - Destination files must not be folders, destination folders must not be files
|
|
''' Without wildcards (single file/folder):
|
|
''' - Source file/folder must exist and be a file/folder
|
|
''' - Parent folder of Destination must exist
|
|
''' - Destination must not be an existing folder/file
|
|
''' - Destination file/folder must not exist if pbOverWrite = False
|
|
''' - Destination file must not have the read-only attribute set
|
|
|
|
Dim bCopyMove As Boolean ' Return value
|
|
Dim bCopy As Boolean ' True if Copy, False if Move
|
|
Dim bFile As Boolean ' True if File, False if Folder
|
|
Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
|
|
Dim bWildCards As Boolean ' True if wildcards found in Source
|
|
Dim bCreateFolder As Boolean ' True when the destination folder should be created
|
|
Dim bDestExists As Boolean ' True if destination exists
|
|
Dim sSourceUrl As String ' Alias for Source
|
|
Dim sDestinationUrl As String ' Alias for Destination
|
|
Dim sDestinationFile As String ' Destination FileName
|
|
Dim sParentFolder As String ' Parent folder of Source
|
|
Dim vFiles As Variant ' Array of candidates for copy/move
|
|
Dim sFile As String ' Single file/folder
|
|
Dim sName As String ' Name (last component) of file
|
|
Dim i As Long
|
|
|
|
' Error handling left to calling routine
|
|
bCopyMove = False
|
|
bCopy = ( Left(psMethod, 4) = "Copy" )
|
|
bFile = ( Right(psMethod, 4) = "File" )
|
|
bWildCards = ( InStr(psSource, "*") + InStr(psSource, "?") + InStr(psSource, "%3F") > 0 ) 'ConvertToUrl() converts sometimes "?" to "%3F"
|
|
bDestExists = False
|
|
|
|
With SF_FileSystem
|
|
|
|
Check:
|
|
If bWildCards Then
|
|
sParentFolder = .GetParentFolderName(psSource)
|
|
If Not .FolderExists(sParentFolder) Then GoTo CatchNoMatch
|
|
If .FileExists(psDestination) Then GoTo CatchFileNotFolder
|
|
If Not .FolderExists(.GetParentFolderName(psDestination)) Then GoTo CatchDestFolderNotExists
|
|
bCreateFolder = Not .FolderExists(psDestination)
|
|
Else
|
|
Select Case bFile
|
|
Case True ' File
|
|
If Not .FileExists(psSource) Then GoTo CatchFileNotExists
|
|
If Not .FolderExists(.GetParentFolderName(psDestination)) Then GoTo CatchSourceFolderNotExists
|
|
If .FolderExists(psDestination) Then GoTo CatchFolderNotFile
|
|
bDestExists = .FileExists(psDestination)
|
|
If pbOverWrite = False And bDestExists = True Then GoTo CatchDestinationExists
|
|
bCreateFolder = False
|
|
Case False ' Folder
|
|
If Not .FolderExists(psSource) Then GoTo CatchSourceFolderNotExists
|
|
If Not .FolderExists(.GetParentFolderName(psDestination)) Then GoTo CatchDestFolderNotExists
|
|
If .FileExists(psDestination) Then GoTo CatchFileNotFolder
|
|
bDestExists = .FolderExists(psDestination)
|
|
If pbOverWrite = False And bDestExists Then GoTo CatchDestinationExists
|
|
bCreateFolder = Not bDestExists
|
|
End Select
|
|
End If
|
|
|
|
Try:
|
|
Set oSfa = SF_Utils._GetUnoService("FileAccess")
|
|
If bWildCards Then
|
|
If bFile Then vFiles = .Files(sParentFolder, .GetName(psSource)) Else vFiles = .SubFolders(sParentFolder, .GetName(psSource))
|
|
If UBound(vFiles) < 0 Then GoTo CatchNoMatch
|
|
' Go through the candidates
|
|
If bCreateFolder Then .CreateFolder(psDestination)
|
|
For i = 0 To UBound(vFiles)
|
|
sFile = vFiles(i)
|
|
sDestinationFile = .BuildPath(psDestination, .GetName(sFile))
|
|
If bFile Then bDestExists = .FileExists(sDestinationFile) Else bDestExists = .FolderExists(sDestinationFile)
|
|
If pbOverWrite = False Then
|
|
If bDestExists Then GoTo CatchDestinationExists
|
|
If .FolderExists(sDestinationFile) Then GoTo CatchDestinationExists
|
|
End If
|
|
sSourceUrl = ._ConvertToUrl(sFile)
|
|
sDestinationUrl = ._ConvertToUrl(sDestinationFile)
|
|
If bDestExists Then
|
|
If oSfa.isReadOnly(sDestinationUrl) Then GoTo CatchDestinationReadOnly
|
|
End If
|
|
Select Case bCopy
|
|
Case True : oSfa.copy(sSourceUrl, sDestinationUrl)
|
|
Case False : oSfa.move(sSourceUrl, sDestinationUrl)
|
|
End Select
|
|
Next i
|
|
Else
|
|
sSourceUrl = ._ConvertToUrl(psSource)
|
|
sDestinationUrl = ._ConvertToUrl(psDestination)
|
|
If bDestExists Then
|
|
If oSfa.isReadOnly(sDestinationUrl) Then GoTo CatchDestinationReadOnly
|
|
End If
|
|
If bCreateFolder Then .CreateFolder(psDestination)
|
|
Select Case bCopy
|
|
Case True : oSfa.copy(sSourceUrl, sDestinationUrl)
|
|
Case False : oSfa.move(sSourceUrl, sDestinationUrl)
|
|
End Select
|
|
End If
|
|
|
|
End With
|
|
|
|
bCopyMove = True
|
|
|
|
Finally:
|
|
_CopyMove = bCopyMove
|
|
Exit Function
|
|
CatchFileNotExists:
|
|
SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "Source", psSource)
|
|
GoTo Finally
|
|
CatchSourceFolderNotExists:
|
|
SF_Exception.RaiseFatal(UNKNOWNFOLDERERROR, "Source", psSource)
|
|
GoTo Finally
|
|
CatchDestFolderNotExists:
|
|
SF_Exception.RaiseFatal(UNKNOWNFOLDERERROR, "Destination", psDestination)
|
|
GoTo Finally
|
|
CatchFolderNotFile:
|
|
SF_Exception.RaiseFatal(NOTAFILEERROR, "Destination", psDestination)
|
|
GoTo Finally
|
|
CatchDestinationExists:
|
|
SF_Exception.RaiseFatal(OVERWRITEERROR, "Destination", psDestination)
|
|
GoTo Finally
|
|
CatchNoMatch:
|
|
SF_Exception.RaiseFatal(NOFILEMATCHERROR, "Source", psSource)
|
|
GoTo Finally
|
|
CatchFileNotFolder:
|
|
SF_Exception.RaiseFatal(NOTAFOLDERERROR, "Destination", psDestination)
|
|
GoTo Finally
|
|
CatchDestinationReadOnly:
|
|
SF_Exception.RaiseFatal(READONLYERROR, "Destination", Iif(bWildCards, sDestinationFile, psDestination))
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem._CopyMove
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function _CountTextLines(ByVal psFileName As String _
|
|
, Optional ByVal pbIncludeBlanks As Boolean _
|
|
) As Long
|
|
''' Convenient function to count the number of lines in a textfile
|
|
''' Args:
|
|
''' psFileName: the file in FileNaming notation
|
|
''' pbIncludeBlanks: if True (default), zero-length lines are included
|
|
''' Returns:
|
|
''' The number of lines, f.i. to ease array sizing. -1 if file reading error
|
|
|
|
Dim lLines As Long ' Return value
|
|
Dim oFile As Object ' File handler
|
|
Dim sLine As String ' The last line read
|
|
|
|
Try:
|
|
lLines = 0
|
|
If IsMissing(pbIncludeBlanks) Then pbIncludeBlanks = True
|
|
Set oFile = SF_FileSystem.OpenTextFile(psFileName, ForReading)
|
|
With oFile
|
|
If Not IsNull(oFile) Then
|
|
Do While Not .AtEndOfStream
|
|
sLine = .ReadLine()
|
|
lLines = lLines + Iif(Len(sLine) > 0 Or pbIncludeBlanks, 1, 0)
|
|
Loop
|
|
End If
|
|
.CloseFile()
|
|
Set oFile = .Dispose()
|
|
End With
|
|
|
|
Finally:
|
|
_CountTextLines = lLines
|
|
Exit Function
|
|
End Function ' ScriptForge.SF_FileSystem._CountTextLines
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _Delete(psMethod As String _
|
|
, psFile As String _
|
|
) As Boolean
|
|
''' Checks the argument and executes the given psMethod
|
|
''' Args:
|
|
''' psMethod: CopyFile/CopyFolder or MoveFile/MoveFolder
|
|
''' psFile: Either File/FolderName
|
|
''' or NamePattern which can include wildcard characters, for one or more files/folders to be deleted
|
|
''' Next checks are done:
|
|
''' With wildcards (multiple files/folders):
|
|
''' - Parent folder of File must exist
|
|
''' - At least one file matches the wildcards expression
|
|
''' - Files or folders to delete must not have the read-only attribute set
|
|
''' Without wildcards (single file/folder):
|
|
''' - File/folder must exist and be a file/folder
|
|
''' - A file or folder to delete must not have the read-only attribute set
|
|
|
|
Dim bDelete As Boolean ' Return value
|
|
Dim bFile As Boolean ' True if File, False if Folder
|
|
Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
|
|
Dim bWildCards As Boolean ' True if wildcards found in File
|
|
Dim sFileUrl As String ' Alias for File
|
|
Dim sParentFolder As String ' Parent folder of File
|
|
Dim vFiles As Variant ' Array of candidates for deletion
|
|
Dim sFile As String ' Single file/folder
|
|
Dim sName As String ' Name (last component) of file
|
|
Dim i As Long
|
|
|
|
' Error handling left to calling routine
|
|
bDelete = False
|
|
bFile = ( Right(psMethod, 4) = "File" )
|
|
bWildCards = ( InStr(psFile, "*") + InStr(psFile, "?") + InStr(psFile, "%3F") > 0 ) 'ConvertToUrl() converts sometimes "?" to "%3F"
|
|
|
|
With SF_FileSystem
|
|
|
|
Check:
|
|
If bWildCards Then
|
|
sParentFolder = .GetParentFolderName(psFile)
|
|
If Not .FolderExists(sParentFolder) Then GoTo CatchNoMatch
|
|
Else
|
|
Select Case bFile
|
|
Case True ' File
|
|
If .FolderExists(psFile) Then GoTo CatchFolderNotFile
|
|
If Not .FileExists(psFile) Then GoTo CatchFileNotExists
|
|
Case False ' Folder
|
|
If .FileExists(psFile) Then GoTo CatchFileNotFolder
|
|
If Not .FolderExists(psFile) Then GoTo CatchFolderNotExists
|
|
End Select
|
|
End If
|
|
|
|
Try:
|
|
Set oSfa = SF_Utils._GetUnoService("FileAccess")
|
|
If bWildCards Then
|
|
If bFile Then vFiles = .Files(sParentFolder) Else vFiles = .SubFolders(sParentFolder)
|
|
' Select candidates
|
|
For i = 0 To UBound(vFiles)
|
|
If Not SF_String.IsLike(.GetName(vFiles(i)), .GetName(psFile)) Then vFiles(i) = ""
|
|
Next i
|
|
vFiles = SF_Array.TrimArray(vFiles)
|
|
If UBound(vFiles) < 0 Then GoTo CatchNoMatch
|
|
' Go through the candidates
|
|
For i = 0 To UBound(vFiles)
|
|
sFile = vFiles(i)
|
|
sFileUrl = ._ConvertToUrl(sFile)
|
|
If oSfa.isReadOnly(sFileUrl) Then GoTo CatchReadOnly
|
|
oSfa.kill(sFileUrl)
|
|
Next i
|
|
Else
|
|
sFileUrl = ._ConvertToUrl(psFile)
|
|
If oSfa.isReadOnly(sFileUrl) Then GoTo CatchReadOnly
|
|
oSfa.kill(sFileUrl)
|
|
End If
|
|
|
|
End With
|
|
|
|
bDelete = True
|
|
|
|
Finally:
|
|
_Delete = bDelete
|
|
Exit Function
|
|
CatchFolderNotExists:
|
|
SF_Exception.RaiseFatal(UNKNOWNFOLDERERROR, "FolderName", psFile)
|
|
GoTo Finally
|
|
CatchFileNotExists:
|
|
SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", psFile)
|
|
GoTo Finally
|
|
CatchFolderNotFile:
|
|
SF_Exception.RaiseFatal(NOTAFILEERROR, "FileName", psFile)
|
|
GoTo Finally
|
|
CatchNoMatch:
|
|
SF_Exception.RaiseFatal(NOFILEMATCHERROR, Iif(bFile, "FileName", "FolderName"), psFile)
|
|
GoTo Finally
|
|
CatchFileNotFolder:
|
|
SF_Exception.RaiseFatal(NOTAFOLDERERROR, "FolderName", psFile)
|
|
GoTo Finally
|
|
CatchReadOnly:
|
|
SF_Exception.RaiseFatal(READONLYERROR, Iif(bFile, "FileName", "FolderName"), Iif(bWildCards, sFile, psFile))
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem._Delete
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _GetConfigFolder(ByVal psFolder As String) As String
|
|
''' Returns one of next configuration folders: see https://api.libreoffice.org/docs/idl/ref/servicecom_1_1sun_1_1star_1_1util_1_1PathSubstitution.html
|
|
''' inst => Installation path of LibreOffice
|
|
''' prog => Program path of LibreOffice
|
|
''' user => The user installation/config directory
|
|
''' work => The work directory of the user. Under Windows this would be the "MyDocuments" subdirectory. Under Unix this would be the home-directory
|
|
''' home => The home directory of the user. Under Unix this would be the home- directory.
|
|
''' Under Windows this would be the CSIDL_PERSONAL directory, for example "Documents and Settings\<username>\Documents"
|
|
''' temp => The current temporary directory
|
|
|
|
Dim oSubst As Object ' com.sun.star.util.PathSubstitution
|
|
Dim sConfig As String ' Return value
|
|
|
|
sConfig = ""
|
|
Set oSubst = SF_Utils._GetUNOService("PathSubstitution")
|
|
If Not IsNull(oSubst) Then sConfig = oSubst.getSubstituteVariableValue("$(" & psFolder & ")") & "/"
|
|
|
|
_GetConfigFolder = SF_FileSystem._ConvertFromUrl(sConfig)
|
|
|
|
End Function ' ScriptForge.FileSystem._GetConfigFolder
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function _ParseUrl(psUrl As String) As Object
|
|
''' Returns a com.sun.star.util.URL structure based on the argument
|
|
|
|
Dim oParse As Object ' com.sun.star.util.URLTransformer
|
|
Dim bParsed As Boolean ' True if parsing is successful
|
|
Dim oUrl As New com.sun.star.util.URL ' Return value
|
|
|
|
oUrl.Complete = psUrl
|
|
Set oParse = SF_Utils._GetUNOService("URLTransformer")
|
|
bParsed = oParse.parseStrict(oUrl, "")
|
|
If bParsed Then oUrl.Path = ConvertToUrl(oUrl.Path)
|
|
|
|
Set _ParseUrl = oUrl
|
|
|
|
End Function ' ScriptForge.SF_FileSystem._ParseUrl
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function _SFInstallFolder() As String
|
|
''' Returns the installation folder of the ScriptForge library
|
|
''' Either:
|
|
''' - The library is present in [My Macros & Dialogs]
|
|
''' ($config)/basic/ScriptForge
|
|
''' - The library is present in [LibreOffice Macros & Dialogs]
|
|
''' ($install)/share/basic/ScriptForge
|
|
|
|
Dim sFolder As String ' Folder
|
|
|
|
_SFInstallFolder = ""
|
|
|
|
sFolder = BuildPath(ConfigFolder, "basic/ScriptForge")
|
|
If Not FolderExists(sFolder) Then
|
|
sFolder = BuildPath(InstallFolder, "share/basic/ScriptForge")
|
|
If Not FolderExists(sFolder) Then Exit Function
|
|
End If
|
|
|
|
_SFInstallFolder = _ConvertFromUrl(sFolder)
|
|
|
|
End Function ' ScriptForge.SF_FileSystem._SFInstallFolder
|
|
|
|
REM ============================================ END OF SCRIPTFORGE.SF_FileSystem
|
|
</script:module> |