diff options
Diffstat (limited to 'wizards/source/scriptforge/SF_FileSystem.xba')
| -rw-r--r-- | wizards/source/scriptforge/SF_FileSystem.xba | 2128 |
1 files changed, 2128 insertions, 0 deletions
diff --git a/wizards/source/scriptforge/SF_FileSystem.xba b/wizards/source/scriptforge/SF_FileSystem.xba new file mode 100644 index 000000000..39ea4888e --- /dev/null +++ b/wizards/source/scriptforge/SF_FileSystem.xba @@ -0,0 +1,2128 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_FileSystem" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= +REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === +REM === Full documentation is available on https://help.libreoffice.org/ === +REM ======================================================================================================================= + +Option Compatible +Option Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_FileSystem +''' ============= +''' Class implementing the file system service +''' for common file and folder handling routines +''' Including copy and move of files and folders, with or without wildcards +''' The design choices are largely inspired by +''' https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/filesystemobject-object +''' The File and Folder classes have been found redundant with the current class and have not been implemented +''' The implementation is mainly based on the XSimpleFileAccess UNO interface +''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1ucb_1_1XSimpleFileAccess.html +''' +''' Subclasses: +''' SF_TextStream +''' +''' Definitions: +''' File and folder names may be expressed either in the (preferable because portable) URL form +''' or in the more usual operating system notation (e.g. C:\... for Windows) +''' The notation, both for arguments and for returned values +''' is determined by the FileNaming property: either "URL" (default) or "SYS" +''' +''' FileName: the full name of the file including the path without any ending path separator +''' FolderName: the full name of the folder including the path and the ending path separator +''' Name: the last component of the File- or FolderName including its extension +''' BaseName: the last component of the File- or FolderName without its extension +''' NamePattern: any of the above names containing wildcards in its last component +''' Admitted wildcards are: the "?" represents any single character +''' the "*" represents zero, one, or multiple characters +''' +''' Service invocation example: +''' Dim FSO As Variant +''' Set FSO = CreateScriptService("FileSystem") +''' +''' Detailed user documentation: +''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_filesystem.html?DbPAR=BASIC +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +Const UNKNOWNFILEERROR = "UNKNOWNFILEERROR" ' Source file does not exist +Const UNKNOWNFOLDERERROR = "UNKNOWNFOLDERERROR" ' Source folder or Destination folder does not exist +Const NOTAFILEERROR = "NOTAFILEERROR" ' Destination is a folder, not a file +Const NOTAFOLDERERROR = "NOTAFOLDERERROR" ' Destination is a file, not a folder +Const OVERWRITEERROR = "OVERWRITEERROR" ' Destination can not be overwritten +Const READONLYERROR = "READONLYERROR" ' Destination has its read-only attribute set +Const NOFILEMATCHERROR = "NOFILEMATCHFOUND" ' No file matches Source containing wildcards +Const FOLDERCREATIONERROR = "FOLDERCREATIONERROR" ' FolderName is an existing folder or file + +REM ============================================================ MODULE CONSTANTS + +''' TextStream open modes +Const cstForReading = 1 +Const cstForWriting = 2 +Const cstForAppending = 8 + +REM ===================================================== CONSTRUCTOR/DESTRUCTOR + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + Set Dispose = Nothing +End Function ' ScriptForge.SF_FileSystem Explicit destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get ConfigFolder() As String +''' Return the configuration folder of LibreOffice + +Const cstThisSub = "FileSystem.getConfigFolder" + + SF_Utils._EnterFunction(cstThisSub) + ConfigFolder = SF_FileSystem._GetConfigFolder("user") + SF_Utils._ExitFunction(cstThisSub) + +End Property ' ScriptForge.SF_FileSystem.ConfigFolder + +REM ----------------------------------------------------------------------------- +Property Get ExtensionsFolder() As String +''' Return the folder containing the 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 +</script:module>
\ No newline at end of file |