Current File : //usr/lib/libreoffice/share/basic/ScriptForge/SF_FileSystem.xba
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="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 "ANY" (default), "URL" 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
'''
''' Disk file systems and document's internal file systems
''' All the implemented properties and methods are applicable on usual disk file systems.
''' Root is usually something like "C:\" or "/" or their URL equivalents
''' Now, Libreoffice documents have an internal file system as well. Many of the proposed methods
''' support document's file systems too, however, for some of them, with restrictions.
''' Read the comments in the individual methods below.
''' It makes browsing folders and files, adding, replacing files possible. Updates will be
''' saved with the document.
''' VERY POWERFUL but KNOW WHAT YOU'RE DOING !!
''' The root of a document's file system is obtained from the "FileSystem" property of a document instance, like in:
''' Dim root As String, doc As Object, ui As Object
''' Set ui = CreateScriptService("ui")
''' Set doc = ui.GetDocument(ThisComponent)
''' root = doc.FileSystem
''' The file manifest.xml is managed automatically.
''' The FileNaming setting is ignored.
'''
''' 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
Const FILESYSTEMERROR = "FILESYSTEMERROR" ' The method is not applicable on document's file systems
REM ============================================================ MODULE CONSTANTS
''' TextStream open modes
Const cstForReading = 1
Const cstForWriting = 2
Const cstForAppending = 8
''' Document file system
Const DOCFILESYSTEM = "vnd.sun.star.tdoc:/"
''' Folders and files scanning
Const cstSEPARATOR = "//;" ' Separates folders or files in the accumulators
Const cstFILES = 1 ' Caler = Files()
Const cstFOLDERS = 2 ' Caller = SubFolders()
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 extensions installed for the current user
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.
''' The method is not supported for document's internal file systems.
''' 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
''' FILESYSTEMERROR The method is not applicable on document's file systems
''' 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
sFile = FileName1 : iFile = 1
If SF_FileSystem._IsDocFileSystem(sFile) Then GoTo CatchNotSupported
sFile = FileName2 : iFile = 2
If SF_FileSystem._IsDocFileSystem(sFile) Then GoTo CatchNotSupported
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
CatchNotSupported:
SF_Exception.RaiseFatal(FILESYSTEMERROR, "FileName" & iFile, Split(cstThisSub, ".")(1), 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 ExtensionFolder(Optional ByVal Extension As Variant) As String
''' Return the folder where the given extension is installed. The argument must
''' be in the list of extensions provided by the SF_Platform.Extensions property
''' Args:
''' Extension: a valid extension name
''' Returns:
''' The requested folder using the FileNaming notation
''' Example:
''' MsgBox FSO.ExtensionFolder("apso.python.script.organizer")
Dim sFolder As String ' Return value
Static vExtensions As Variant ' Cached list of existing extension names
Dim oPackage As Object ' /singletons/com.sun.star.deployment.PackageInformationProvider
Const cstThisSub = "FileSystem.ExtensionFolder"
Const cstSubArgs = "Extension"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
sFolder = ""
Check:
If IsEmpty(vExtensions) Then vExtensions = SF_Platform.Extensions
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._Validate(Extension, "Extension", V_STRING, vExtensions) Then GoTo Finally
End If
Try:
' Search an individual folder
Set oPackage = SF_Utils._GetUnoService("PackageInformationProvider")
sFolder = oPackage.getPackageLocation(Extension)
Finally:
ExtensionFolder = SF_FileSystem._ConvertFromUrl(sFolder)
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_FileSystem.ExtensionFolder
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 _
, Optional ByVal IncludeSubfolders As Variant _
) As Variant
''' Return an array of the FileNames stored in the given folder. The folder must exist
''' Subfolders may be optionally explored too.
''' If the number of files exceeds a reasonable amount (> 1000 ?), the process time may become long.
''' Args:
''' FolderName: the folder to explore
''' Filter: contains wildcards ("?" and "*") to limit the list to the relevant files (default = "")
''' IncludeSubfolders: when True (default = False), subfolders are explored too.
''' 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\", IncludeSubfolders := True)
Dim vFiles As Variant ' Return value
Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
Dim sFilesColl As String ' cstSEPARATOR delimited string of list of files (FileNaming notation)
Dim i As Long
Const cstThisSub = "FileSystem.Files"
Const cstSubArgs = "FolderName, [Filter=""""], [IncludeSubfolders=False]"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
vFiles = Array()
Check:
If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = ""
If IsMissing(IncludeSubfolders) Or IsEmpty(IncludeSubfolders) Then IncludeSubfolders = False
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
If Not SF_Utils._Validate(IncludeSubfolders, "IncludeSubfolders", V_BOOLEAN) Then GoTo Finally
End If
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:
sFilesColl = ""
Set oSfa = SF_Utils._GetUnoService("FileAccess")
SF_FileSystem._ScanFolder(cstFiles, sFilesColl, FolderName, oSfa, Filter, IncludeSubfolders)
If Len(sFilesColl) > Len(cstSEPARATOR) Then vFiles() = Split(Mid(sFilesColl, Len(cstSEPARATOR) + 1), cstSEPARATOR)
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
''' 0 when FileName belongs to a document's internal file systems.
''' Exceptions:
''' UNKNOWNFILEERROR The file does not exist or 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
If SF_FileSystem._IsDocFileSystem(FileName) Then
curSize = 0
Else
With ScriptForge.SF_Session
curSize = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _
, _ConvertFromUrl(FileName))
End With
End If
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
''' The method is not supported for document's internal file systems.
''' 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 or is a folder
''' FILESYSTEMERROR The method is not applicable on document's file systems
''' 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
If SF_FileSystem._IsDocFileSystem(FileName) Then GoTo CatchNotSupported
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
CatchNotSupported:
SF_Exception.RaiseFatal(FILESYSTEMERROR, "FileName", Split(cstThisSub, ".")(1), 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(Optional ByVal Extension As Variant) 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 has as suffix the given extension.
''' Example:
''' Dim a As String
''' FSO.FileNaming = "SYS"
''' a = FSO.GetTempName("txt") ' /tmp/SF_123456.txt
''' a = FSO.GetTempName() ' /tmp/SF_234567
Dim sFile As String ' Return value
Dim sExtension As String ' The given extension preceded by a dot
Dim lRandom As Long ' Random integer
Const cstThisSub = "FileSystem.GetTempName"
Const cstSubArgs = ""
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
sFile = ""
Check:
If IsMissing(Extension) Or IsEmpty(Extension) Then Extension = ""
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._Validate(Extension, "Extension", V_STRING) Then GoTo Catch
End If
Try:
lRandom = SF_Session.ExecuteCalcFunction("RANDBETWEEN.NV", 1, 999999)
If Len(Extension) > 0 Then sExtension = "." & Extension Else sExtension = ""
sFile = SF_FileSystem.TemporaryFolder & "SF_" & Right("000000" & lRandom, 6) & sExtension
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
''' The method is not supported for document's internal file systems.
''' 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 or is a folder
''' FILESYSTEMERROR The method is not applicable on document's file systems
''' 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
If SF_FileSystem._IsDocFileSystem(FileName) Then GoTo CatchNotSupported
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
CatchNotSupported:
SF_Exception.RaiseFatal(FILESYSTEMERROR, "FileName", Split(cstThisSub, ".")(1), 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" _
, "ExtensionFolder" _
, "FileExists" _
, "Files" _
, "FolderExists" _
, "GetBaseName" _
, "GetExtension" _
, "GetFileLen" _
, "GetFileModified" _
, "GetName" _
, "GetParentFolderName" _
, "GetTempName" _
, "HashFile" _
, "MoveFile" _
, "MoveFolder" _
, "Normalize" _
, "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 Normalize(Optional ByVal FileName As Variant) As String
''' Normalize a pathname by collapsing redundant separators and up-level references
''' so that A//B, A/B/, A/./B and A/foo/../B all become A/B.
''' On Windows, it converts forward slashes to backward slashes.
''' The method returns the input string when the file is from a document's internal file systems.
''' Args:
''' FileName: a string representing a file. The file may not exist.
''' Returns:
''' The normalized filename in filenaming notation
''' Example:
''' Print SF_FileSystem.Normalize("A/foo/../B/C/./D//E") ' A/B/C/D/E
Dim sNorm As String ' Return value
Const cstPyHelper = "$" & "_SF_FileSystem__Normalize"
Const cstThisSub = "FileSystem.Normalize"
Const cstSubArgs = "FileName"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
sNorm = ""
Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
End If
Try:
If SF_FileSystem._IsDocFileSystem(FileName) Then
sNorm = FileName
Else
With ScriptForge.SF_Session
sNorm = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _
, _ConvertFromUrl(FileName))
' The Python os.path expects and returns a file name in os notation
If SF_FileSystem.FileNaming <> "SYS" Then sNorm = ConvertToUrl(sNorm)
End With
End If
Finally:
Normalize = sNorm
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_FileSystem.Normalize
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 ' When True, file to open does exist
Dim bEmbeddedFile As Boolean ' When True, file to open is embedded in a document's internal file system
Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
Const cstThisSub = "FileSystem.OpenTextFile"
Const cstSubArgs = "FileName, [IOMode=1|2|8], [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 = cstForReading
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(cstForReading, cstForWriting, cstForAppending)) _
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
bEmbeddedFile = SF_FileSystem._IsDocFileSystem(FileName)
End With
Try:
' Create and initialize TextStream class instance
Set oTextStream = New SF_TextStream
With oTextStream
.[Me] = oTextStream
.[_Parent] = SF_FileSystem
._IsEmbeddedFile = bEmbeddedFile
If bEmbeddedFile And (IOMode = cstForWriting Or IOMode = cstForAppending) Then
' Updates of an embedded file are done on a copy
._EmbeddedFileName = SF_FileSystem._ConvertToUrl(FileName)
._FileName = SF_FileSystem._ConvertToUrl(SF_FileSystem.GetTempName(SF_FileSystem.GetExtension(FileName)))
' Create the copy if relevant
If bExists Then
Set oSfa = SF_Utils._GetUnoService("FileAccess")
oSfa.copy(._EmbeddedFileName, ._FileName)
End If
Else
._FileName = SF_FileSystem._ConvertToUrl(FileName)
End If
._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
''' The method is not supported for document's internal file systems.
''' 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 suffix filter (if not "*") and "*.*"
''' Returns:
''' The selected FileName in FileNaming format or "" if the dialog was cancelled
''' Exceptions:
''' FILESYSTEMERROR The method is not applicable on document's file systems
''' 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
If SF_FileSystem._IsDocFileSystem(DefaultFile) Then GoTo CatchNotSupported
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)
' Do not reuse a FilePicker, side effects observed (a.o. TDF#154462)
.dispose()
End With
Finally:
PickFile = SF_FileSystem._ConvertFromUrl(sFile)
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
CatchNotSupported:
SF_Exception.RaiseFatal(FILESYSTEMERROR, "DefaultFile", Split(cstThisSub, ".")(1), DefaultFile)
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
''' The method is not supported for document's internal file systems.
''' 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
''' Exceptions:
''' FILESYSTEMERROR The method is not applicable on document's file systems
''' 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
If SF_FileSystem._IsDocFileSystem(DefaultFolder) Then GoTo CatchNotSupported
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
CatchNotSupported:
SF_Exception.RaiseFatal(FILESYSTEMERROR, "DefaultFolder", Split(cstThisSub, ".")(1), DefaultFolder)
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 _
, Optional ByVal IncludeSubfolders As Variant _
) As Variant
''' Return an array of the FolderNames stored in the given folder. The folder must exist,
''' Subfolders may be optionally explored too.
''' Args:
''' FolderName: the folder to explore
''' Filter: contains wildcards ("?" and "*") to limit the list to the relevant folders (default = "")
''' IncludeSubfolders: when True (default = False), subfolders are explored too.
''' 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\", IncludeSubfolders := True)
Dim vSubFolders As Variant ' Return value
Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
Dim sFoldersColl As String ' cstSEPARATOR delimited string of list of folders (FileNaming notation)
Dim i As Long
Const cstThisSub = "FileSystem.SubFolders"
Const cstSubArgs = "FolderName, [Filter=""""], [IncludeSubfolders=False]"
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
vSubFolders = Array()
Check:
If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = ""
If IsMissing(IncludeSubfolders) Or IsEmpty(IncludeSubfolders) Then IncludeSubfolders = False
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
If Not SF_Utils._Validate(IncludeSubfolders, "IncludeSubfolders", V_BOOLEAN) Then GoTo Finally
End If
If SF_FileSystem.FileExists(FolderName) Then GoTo CatchFile ' Must not be a file
If Not SF_FileSystem.FolderExists(FolderName) Then GoTo CatchFolder ' Top folder must exist
Try:
sFoldersColl = ""
Set oSfa = SF_Utils._GetUnoService("FileAccess")
SF_FileSystem._ScanFolder(cstFolders, sFoldersColl, FolderName, oSfa, Filter, IncludeSubfolders)
If Len(sFoldersColl) > Len(cstSEPARATOR) Then vSubFolders() = Split(Mid(sFoldersColl, Len(cstSEPARATOR) + 1), cstSEPARATOR)
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
''' Remarks: psFile might contain wildcards
''' Files from document's file systems are never converted
Const cstQuestion = "$QUESTION$", cstStar = "$STAR$" ' Special tokens to replace wildcards
If SF_FileSystem.FileNaming = "SYS" And Not SF_FileSystem._IsDocFileSystem(psFile) 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) <> "URL"
''' Called at the top of methods receiving file names as arguments
''' Remarks: psFile might contain wildcards
''' Files from document's file systems are never converted
If SF_FileSystem.FileNaming = "URL" Or SF_FileSystem._IsDocFileSystem(psFile) 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 CatchDestFolderNotExists
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 _IsDocFileSystem(psFile As String) As Boolean
''' Returns True when the argument designates a document's internal file system
_IsDocFileSystem = SF_String.StartsWith(psFile, DOCFILESYSTEM, CaseSensitive := True)
End Function ' ScriptForge.SF_FileSystem._IsDocFileSystem
REM -----------------------------------------------------------------------------
Private Sub _ScanFolder(ByVal piTarget As Integer _
, ByRef psItemsColl As String _
, ByVal psFolderName As String _
, ByRef poSfa As Object _
, ByVal psFilter As String _
, ByVal pbIncludeSubFolders As Boolean _
)
''' Scan a folder and, when requested, its subfolders recursively.
''' The psItemsColl in-out argument concatenates, depending on the target,
''' either all files or all folders found.
''' The Sub calls itself recursively when relevant.
''' Args:
''' piTarget: 1 when caller routine = Files(), 2 when caller routine = SubFolders()
''' It determines the type of items to collect: files or folders
''' psItemsColl: the current and future list of folders or files (FileNaming format) separated with cstSEPARATOR
''' psFolderName: the folder to scan (FileNaming format)
''' poSfa: com.sun.star.ucb.SimpleFileAccess
''' psFilter: contains wildcards ("?" and "*") to limit the list to the relevant folders or files.
''' Zero-length string when not applicable.
''' pbIncludeSubfolders: when True, subfolders are explored too.
Dim vSubFolders As Variant ' Array of subfolders 1st level in URL notation
Dim vFiles As Variant ' Array of files present in psFolderName in FileNaming notation
Dim lFiles As Long ' Number of files found passing the filter
Dim sFolderName As String ' URL alias for psFolderName
Dim sItem As String ' Single folder or single file in FileNaming notation
Dim sItemName As String ' Base name of sItem
Dim bFolder As Boolean ' When True, the considered string points to a folder, not a file
Dim bFilter As Boolean ' When True, no filter or the filter is passed
Dim i As Long
Check:
On Local Error Goto catch
Try:
With poSfa
' Get SubFolders, initialize files list
sFolderName = SF_FileSystem._ConvertToUrl(psFolderName)
vSubFolders = .getFolderContents(sFolderName, True)
If UBound(vSubFolders) < 0 Then Exit Sub
vFiles = Array()
If piTarget = cstFiles Then
lFiles = 0
ReDim vFiles(0 To UBound(vSubFolders))
End If
' List includes files: remove them or adjust notations of folders
' When piTarget = cstFiles, the list of files is stored in the vFiles() array
For i = 0 To UBound(vSubFolders)
sItem = SF_FileSystem._ConvertFromUrl(vSubFolders(i))
bFolder = .isFolder(vSubFolders(i))
Select Case piTarget
Case cstFiles
If bFolder Then
vSubFolders(i) = sItem & "/"
Else
' Build list of files passing the filter
bFilter = ( Len(psFilter) = 0 )
If Not bFilter Then
sItemName = SF_FileSystem.GetName(sItem)
bFilter = SF_String.IsLike(sItemName, psFilter)
End If
If bFilter Then ' Copy files from folders + files list
vFiles(lFiles) = sItem
lFiles = lFiles + 1
End If
vSubFolders(i) = "" ' Keep folders only
End If
Case cstFolders
If bFolder Then vSubFolders(i) = sItem & "/" Else vSubFolders(i) = ""
' Reduce list to those passing the filter
If Len(psFilter) > 0 And Len(vSubFolders(i)) > 0 Then
sItemName = SF_FileSystem.GetName(sItem)
If Not SF_String.IsLike(sItemName, psFilter) Then vSubFolders(i) = ""
End If
End Select
Next i
vSubFolders = SF_Array.TrimArray(vSubFolders)
' Store the list of either files or subfolders in the global collection
Select Case piTarget
Case cstFiles
If lFiles > 0 Then
ReDim Preserve vFiles(0 To lFiles - 1)
psItemsColl = psItemsColl & cstSEPARATOR & Join(vFiles, cstSEPARATOR)
End If
Case cstFolders
If UBound(vSubFolders) >= 0 Then psItemsColl = psItemsColl & cstSEPARATOR & Join(vSubFolders, cstSEPARATOR)
End Select
' Scan each subfolder when relevant
If pbIncludeSubfolders Then
For i = 0 To UBound(vSubFolders)
_ScanFolder(piTarget, psItemsColl, vSubFolders(i), poSfa, psFilter, True)
Next i
End If
End With
Finally:
Exit Sub
Catch:
SF_Exception.Clear()
psItemsColl = ""
GoTo Finally
End Sub ' ScriptForge.SF_FileSystem._ScanFolder
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>
Mini Shell