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 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. ''' 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 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 _ ) 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" _ , "ExtensionFolder" _ , "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