forked from amazingfate/loongoffice
6814e4375c
Extract of the bug report (Rafael Lima)
This bug affects a method from the ScriptForge library,
more specifically the GetTempName method from
the FileSystem service, which relies on calling RANDBETWEEN.
Because of this bug, GetTempName only works in English,
but fails in other languages. Below is a sample code
for testing the GetTempName error.
Sub TestTempName
GlobalScope.BasicLibraries.LoadLibrary("ScriptForge")
fs = CreateScriptService("FileSystem")
MsgBox fs.GetTempName()
End sub
Interestingly changing RANDBETWEEN for RANDBETWEEN.NV
in the macro above will work.
Occurrences of the use of RANDBETWEEN:
wizards/source/scriptforge/SF_FileSystem.xba
wizards/source/sfdocuments/SF_Calc.xba
Change-Id: Iea38f11acb7113aa5eaab1feff7a0e64a739aada
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/137691
Tested-by: Jean-Pierre Ledure <jp@ledure.be>
Reviewed-by: Jean-Pierre Ledure <jp@ledure.be>
Tested-by: Jenkins
2170 lines
94 KiB
XML
2170 lines
94 KiB
XML
<?xml version="1.0" encoding="UTF-8"?>
|
|
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
|
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_FileSystem" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
|
|
REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
|
|
REM === Full documentation is available on https://help.libreoffice.org/ ===
|
|
REM =======================================================================================================================
|
|
|
|
Option Compatible
|
|
Option Explicit
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
''' SF_FileSystem
|
|
''' =============
|
|
''' Class implementing the file system service
|
|
''' for common file and folder handling routines
|
|
''' Including copy and move of files and folders, with or without wildcards
|
|
''' The design choices are largely inspired by
|
|
''' https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/filesystemobject-object
|
|
''' The File and Folder classes have been found redundant with the current class and have not been implemented
|
|
''' The implementation is mainly based on the XSimpleFileAccess UNO interface
|
|
''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1ucb_1_1XSimpleFileAccess.html
|
|
'''
|
|
''' Subclasses:
|
|
''' SF_TextStream
|
|
'''
|
|
''' Definitions:
|
|
''' File and folder names may be expressed either in the (preferable because portable) URL form
|
|
''' or in the more usual operating system notation (e.g. C:\... for Windows)
|
|
''' The notation, both for arguments and for returned values
|
|
''' is determined by the FileNaming property: either "URL" (default) or "SYS"
|
|
'''
|
|
''' FileName: the full name of the file including the path without any ending path separator
|
|
''' FolderName: the full name of the folder including the path and the ending path separator
|
|
''' Name: the last component of the File- or FolderName including its extension
|
|
''' BaseName: the last component of the File- or FolderName without its extension
|
|
''' NamePattern: any of the above names containing wildcards in its last component
|
|
''' Admitted wildcards are: the "?" represents any single character
|
|
''' the "*" represents zero, one, or multiple characters
|
|
'''
|
|
''' Service invocation example:
|
|
''' Dim FSO As Variant
|
|
''' Set FSO = CreateScriptService("FileSystem")
|
|
'''
|
|
''' Detailed user documentation:
|
|
''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_filesystem.html?DbPAR=BASIC
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
REM ================================================================== EXCEPTIONS
|
|
|
|
Const UNKNOWNFILEERROR = "UNKNOWNFILEERROR" ' Source file does not exist
|
|
Const UNKNOWNFOLDERERROR = "UNKNOWNFOLDERERROR" ' Source folder or Destination folder does not exist
|
|
Const NOTAFILEERROR = "NOTAFILEERROR" ' Destination is a folder, not a file
|
|
Const NOTAFOLDERERROR = "NOTAFOLDERERROR" ' Destination is a file, not a folder
|
|
Const OVERWRITEERROR = "OVERWRITEERROR" ' Destination can not be overwritten
|
|
Const READONLYERROR = "READONLYERROR" ' Destination has its read-only attribute set
|
|
Const NOFILEMATCHERROR = "NOFILEMATCHFOUND" ' No file matches Source containing wildcards
|
|
Const FOLDERCREATIONERROR = "FOLDERCREATIONERROR" ' FolderName is an existing folder or file
|
|
|
|
REM ============================================================ MODULE CONSTANTS
|
|
|
|
''' TextStream open modes
|
|
Const cstForReading = 1
|
|
Const cstForWriting = 2
|
|
Const cstForAppending = 8
|
|
|
|
REM ===================================================== CONSTRUCTOR/DESTRUCTOR
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Dispose() As Variant
|
|
Set Dispose = Nothing
|
|
End Function ' ScriptForge.SF_FileSystem Explicit destructor
|
|
|
|
REM ================================================================== PROPERTIES
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ConfigFolder() As String
|
|
''' Return the configuration folder of LibreOffice
|
|
|
|
Const cstThisSub = "FileSystem.getConfigFolder"
|
|
|
|
SF_Utils._EnterFunction(cstThisSub)
|
|
ConfigFolder = SF_FileSystem._GetConfigFolder("user")
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
|
|
End Property ' ScriptForge.SF_FileSystem.ConfigFolder
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ExtensionsFolder() As String
|
|
''' Return the folder containing the 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.NV", 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" _
|
|
, "Normalize" _
|
|
, "OpenTextFile" _
|
|
, "PickFile" _
|
|
, "PickFolder" _
|
|
, "SubFolders" _
|
|
)
|
|
|
|
End Function ' ScriptForge.SF_FileSystem.Methods
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function MoveFile(Optional ByVal Source As Variant _
|
|
, Optional ByVal Destination As Variant _
|
|
) As Boolean
|
|
''' Moves one or more files from one location to another
|
|
''' Args:
|
|
''' Source: FileName or NamePattern which can include wildcard characters, for one or more files to be moved
|
|
''' Destination: FileName where the single Source file is to be moved
|
|
''' If Source and Destination have the same parent folder MoveFile amounts to renaming the Source
|
|
''' or FolderName where the multiple files from Source are to be moved
|
|
''' If FolderName does not exist, it is created
|
|
''' Anyway, wildcard characters are not allowed in Destination
|
|
''' Returns:
|
|
''' True if at least one file has been moved
|
|
''' False if an error occurred
|
|
''' An error also occurs if a source using wildcard characters doesn't match any files.
|
|
''' The method stops on the first error it encounters
|
|
''' No attempt is made to roll back or undo any changes made before an error occurs
|
|
''' Exceptions:
|
|
''' UNKNOWNFILEERROR Source does not exist
|
|
''' UNKNOWNFOLDERERROR Source folder or Destination folder does not exist
|
|
''' NOFILEMATCHERROR No file matches Source containing wildcards
|
|
''' NOTAFOLDERERROR Destination is a file, not a folder
|
|
''' NOTAFILEERROR Destination is a folder, not a file
|
|
''' OVERWRITEERROR Destination can not be overwritten
|
|
''' Example:
|
|
''' FSO.FileNaming = "SYS"
|
|
''' FSO.MoveFile("C:\Temp1\*.*", "C:\Temp2\") ' Only files are moved, subfolders are not
|
|
|
|
Dim bMove As Boolean ' Return value
|
|
|
|
Const cstThisSub = "FileSystem.MoveFile"
|
|
Const cstSubArgs = "Source, Destination"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bMove = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(Source, "Source", True) Then GoTo Finally
|
|
If Not SF_Utils._ValidateFile(Destination, "Destination", False) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
bMove = SF_FileSystem._CopyMove("MoveFile", Source, Destination, False)
|
|
|
|
Finally:
|
|
MoveFile = bMove
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.MoveFile
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function MoveFolder(Optional ByVal Source As Variant _
|
|
, Optional ByVal Destination As Variant _
|
|
) As Boolean
|
|
''' Moves one or more folders from one location to another
|
|
''' Args:
|
|
''' Source: FolderName or NamePattern which can include wildcard characters, for one or more folders to be moved
|
|
''' Destination: FolderName where the single Source folder is to be moved
|
|
''' FolderName must not exist
|
|
''' or FolderName where the multiple folders from Source are to be moved
|
|
''' If FolderName does not exist, it is created
|
|
''' Anyway, wildcard characters are not allowed in Destination
|
|
''' Returns:
|
|
''' True if at least one folder has been moved
|
|
''' False if an error occurred
|
|
''' An error also occurs if a source using wildcard characters doesn't match any folders.
|
|
''' The method stops on the first error it encounters
|
|
''' No attempt is made to roll back or undo any changes made before an error occurs
|
|
''' Exceptions:
|
|
''' UNKNOWNFILEERROR Source does not exist
|
|
''' UNKNOWNFOLDERERROR Source folder or Destination folder does not exist
|
|
''' NOFILEMATCHERROR No file matches Source containing wildcards
|
|
''' NOTAFOLDERERROR Destination is a file, not a folder
|
|
''' OVERWRITEERROR Destination can not be overwritten
|
|
''' Example:
|
|
''' FSO.FileNaming = "SYS"
|
|
''' FSO.MoveFolder("C:\Temp1\*", "C:\Temp2\")
|
|
|
|
Dim bMove As Boolean ' Return value
|
|
|
|
Const cstThisSub = "FileSystem.MoveFolder"
|
|
Const cstSubArgs = "Source, Destination"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bMove = False
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(Source, "Source", True) Then GoTo Finally
|
|
If Not SF_Utils._ValidateFile(Destination, "Destination", False) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
bMove = SF_FileSystem._CopyMove("MoveFolder", Source, Destination, False)
|
|
|
|
Finally:
|
|
MoveFolder = bMove
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.MoveFolder
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Normalize(Optional ByVal FileName As Variant) As String
|
|
''' Normalize a pathname by collapsing redundant separators and up-level references
|
|
''' so that A//B, A/B/, A/./B and A/foo/../B all become A/B.
|
|
''' On Windows, it converts forward slashes to backward slashes.
|
|
''' Args:
|
|
''' FileName: a string representing a file. The file may not exist.
|
|
''' Returns:
|
|
''' The normalized filename in filenaming notation
|
|
''' Example:
|
|
''' Print SF_FileSystem.Normalize("A/foo/../B/C/./D//E") ' A/B/C/D/E
|
|
|
|
Dim sNorm As String ' Return value
|
|
Const cstPyHelper = "$" & "_SF_FileSystem__Normalize"
|
|
Const cstThisSub = "FileSystem.Normalize"
|
|
Const cstSubArgs = "FileName"
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sNorm = ""
|
|
|
|
Check:
|
|
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
With ScriptForge.SF_Session
|
|
sNorm = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _
|
|
, _ConvertFromUrl(FileName))
|
|
' The Python os.path expects and returns a file name in os notation
|
|
If SF_FileSystem.FileNaming <> "SYS" Then sNorm = ConvertToUrl(sNorm)
|
|
End With
|
|
|
|
Finally:
|
|
Normalize = sNorm
|
|
SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' ScriptForge.SF_FileSystem.Normalize
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function OpenTextFile(Optional ByVal FileName As Variant _
|
|
, Optional ByVal IOMode As Variant _
|
|
, Optional ByVal Create As Variant _
|
|
, Optional ByVal Encoding As Variant _
|
|
) As Object
|
|
''' Opens a specified file and returns a TextStream object that can be used to read from, write to, or append to the file
|
|
''' Args:
|
|
''' FileName: Identifies the file to open
|
|
''' IOMode: Indicates input/output mode. Can be one of three constants: ForReading, ForWriting, or ForAppending
|
|
''' Create: Boolean value that indicates whether a new file can be created if the specified filename doesn't exist.
|
|
''' The value is True if a new file and its parent folders may be created; False if they aren't created (default)
|
|
''' Encoding: The character set that should be used
|
|
''' Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml
|
|
''' Note that LibreOffice does not implement all existing sets
|
|
''' Default = UTF-8
|
|
''' Returns:
|
|
''' An instance of the SF_TextStream class representing the opened file or a Null object if an error occurred
|
|
''' The method does not check if the file is really a text file
|
|
''' It doesn't check either if the given encoding is implemented in LibreOffice nor if it is the right one
|
|
''' Exceptions:
|
|
''' UNKNOWNFILEERROR File does not exist
|
|
''' Example:
|
|
''' Dim myFile As Object
|
|
''' FSO.FileNaming = "SYS"
|
|
''' Set myFile = FSO.OpenTextFile("C:\Temp\ThisFile.txt", FSO.ForReading)
|
|
''' If Not IsNull(myFile) Then ' ... Go ahead with reading text lines
|
|
|
|
Dim oTextStream As Object ' Return value
|
|
Dim bExists As Boolean ' 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) <> "URL"
|
|
''' 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> |