SSL SF_FileSystem.xba Sprache: unbekannt

Untersuchungsergebnis.xba Download desUnknown {[0] [0] [0]}zum Wurzelverzeichnis wechseln

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_FileSystem" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
REM ===   The ScriptForge library and its associated libraries are part of the LibreOffice project.    ===
REM ===     Full documentation is available on https://help.libreoffice.org/        ===
REM =======================================================================================================================

Option Compatible
Option Explicit

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' SF_FileSystem
''' =============
'''  Class implementing the file system service
'''  for common file and folder handling routines
'''  Including copy and move of files and folders, with or without wildcards
'''  The design choices are largely inspired by
'''   https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/filesystemobject-object
'''   The File and Folder classes have been found redundant with the current class and have not been implemented
'''  The implementation is mainly based on the XSimpleFileAccess UNO interface
'''   https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1ucb_1_1XSimpleFileAccess.html
'''
'''  Subclasses:
'''   SF_TextStream
'''
'''  Definitions:
'''   File and folder names may be expressed either in the (preferable because portable) URL form
'''   or in the more usual operating system notation (e.g. C:\... for Windows)
'''   The notation, both for arguments and for returned values
'''   is determined by the FileNaming property: either "ANY" (default), "URL" or "SYS"
'''
'''    FileName: the full name of the file including the path without any ending path separator
'''    FolderName: the full name of the folder including the path and the ending path separator
'''    Name: the last component of the File- or FolderName including its extension
'''    BaseName: the last component of the File- or FolderName without its extension
'''    NamePattern: any of the above names containing wildcards in its last component
'''     Admitted wildcards are: the "?" represents any single character
'''           the "*" represents zero, one, or multiple characters
'''
'''  Disk file systems and document's internal file systems
'''   All the implemented properties and methods are applicable on usual disk file systems.
'''    Root is usually something like "C:\" or "/" or their URL equivalents
'''   Now, Libreoffice documents have an internal file system as well. Many of the proposed methods
'''   support document's file systems too, however, for some of them, with restrictions.
'''   Read the comments in the individual methods below.
'''   It makes browsing folders and files, adding, replacing files possible. Updates will be
'''   saved with the document.
'''   VERY POWERFUL but KNOW WHAT YOU'RE DOING !!
'''    The root of a document's file system is obtained from the "FileSystem" property of a document instance, like in:
'''     Dim root As String, doc As Object, ui As Object
'''     Set ui = CreateScriptService("ui")
'''     Set doc = ui.GetDocument(ThisComponent)
'''     root = doc.FileSystem
'''    The file manifest.xml is managed automatically.
'''    The FileNaming setting is ignored.
'''
'''  Service invocation example:
'''   Dim FSO As Variant
'''   Set FSO = CreateScriptService("FileSystem")
'''
'''  Detailed user documentation:
'''   https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_filesystem.html?DbPAR=BASIC
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

REM ================================================================== EXCEPTIONS

Const UNKNOWNFILEERROR   = "UNKNOWNFILEERROR"  ' Source file does not exist
Const UNKNOWNFOLDERERROR  = "UNKNOWNFOLDERERROR" ' Source folder or Destination folder does not exist
Const NOTAFILEERROR    = "NOTAFILEERROR"   ' Destination is a folder, not a file
Const NOTAFOLDERERROR   = "NOTAFOLDERERROR"  ' Destination is a file, not a folder
Const OVERWRITEERROR   = "OVERWRITEERROR"  ' Destination can not be overwritten
Const READONLYERROR    = "READONLYERROR"   ' Destination has its read-only attribute set
Const NOFILEMATCHERROR   = "NOFILEMATCHFOUND"  ' No file matches Source containing wildcards
Const FOLDERCREATIONERROR  = "FOLDERCREATIONERROR" ' FolderName is an existing folder or file
Const FILESYSTEMERROR   = "FILESYSTEMERROR"  ' The method is not applicable on document's file systems

REM ============================================================ MODULE CONSTANTS

''' TextStream open modes
Const cstForReading    = 1
Const cstForWriting    = 2
Const cstForAppending   = 8

''' Document file system
Const DOCFILESYSTEM    = "vnd.sun.star.tdoc:/"

''' Folders and files scanning
Const cstSEPARATOR    = "//;" ' Separates folders or files in the accumulators
Const cstFILES     = 1  ' Caler = Files()
Const cstFOLDERS    = 2  ' Caller = SubFolders()

REM ===================================================== CONSTRUCTOR/DESTRUCTOR

REM -----------------------------------------------------------------------------
Public Function Dispose() As Variant
Set Dispose = Nothing
End Function ' ScriptForge.SF_FileSystem Explicit destructor

REM ================================================================== PROPERTIES

REM -----------------------------------------------------------------------------
Property Get ConfigFolder() As String
''' Return the configuration folder of LibreOffice

Const cstThisSub = "FileSystem.getConfigFolder"

SF_Utils._EnterFunction(cstThisSub)
ConfigFolder = SF_FileSystem._GetConfigFolder("user")
SF_Utils._ExitFunction(cstThisSub)

End Property ' ScriptForge.SF_FileSystem.ConfigFolder

REM -----------------------------------------------------------------------------
Property Get ExtensionsFolder() As String
''' Return the folder containing the extensions installed for the current user

Dim oMacro As Object  ' /singletons/com.sun.star.util.theMacroExpander
Const cstThisSub = "FileSystem.getExtensionsFolder"

SF_Utils._EnterFunction(cstThisSub)
Set oMacro = SF_Utils._GetUNOService("MacroExpander")
ExtensionsFolder = SF_FileSystem._ConvertFromUrl(oMacro.ExpandMacros("$UNO_USER_PACKAGES_CACHE") & "/")
SF_Utils._ExitFunction(cstThisSub)

End Property ' ScriptForge.SF_FileSystem.ExtensionsFolder

REM -----------------------------------------------------------------------------
Property Get FileNaming() As Variant
''' Return the current files and folder notation, either "ANY", "URL" or "SYS"
'''  "ANY": methods receive either URL or native file names, but always return URL file names
'''  "URL": methods expect URL arguments and return URL strings (when relevant)
'''  "SYS": idem but operating system notation

Const cstThisSub = "FileSystem.getFileNaming"
SF_Utils._EnterFunction(cstThisSub)
FileNaming = _SF_.FileSystemNaming
SF_Utils._ExitFunction(cstThisSub)

End Property ' ScriptForge.SF_FileSystem.FileNaming (get)

REM -----------------------------------------------------------------------------
Property Let FileNaming(ByVal pvNotation As Variant)
''' Set the files and folders notation: "ANY", "URL" or "SYS"

Const cstThisSub = "FileSystem.setFileNaming"
SF_Utils._EnterFunction(cstThisSub)
If VarType(pvNotation) = V_STRING Then
  Select Case UCase(pvNotation)
   Case "ANY", "URL", "SYS" : _SF_.FileSystemNaming = UCase(pvNotation)
   Case Else ' Unchanged
  End Select
End If
SF_Utils._ExitFunction(cstThisSub)

End Property ' ScriptForge.SF_FileSystem.FileNaming (let)

REM -----------------------------------------------------------------------------
Property Get ForAppending As Integer
''' Convenient constant (see documentation)
ForAppending = cstForAppending
End Property ' ScriptForge.SF_FileSystem.ForAppending

REM -----------------------------------------------------------------------------
Property Get ForReading As Integer
''' Convenient constant (see documentation)
ForReading = cstForReading
End Property ' ScriptForge.SF_FileSystem.ForReading

REM -----------------------------------------------------------------------------
Property Get ForWriting As Integer
''' Convenient constant (see documentation)
ForWriting = cstForWriting
End Property ' ScriptForge.SF_FileSystem.ForWriting

REM -----------------------------------------------------------------------------
Property Get HomeFolder() As String
''' Return the user home folder

Const cstThisSub = "FileSystem.getHomeFolder"

SF_Utils._EnterFunction(cstThisSub)
HomeFolder = SF_FileSystem._GetConfigFolder("home")
SF_Utils._ExitFunction(cstThisSub)

End Property ' ScriptForge.SF_FileSystem.HomeFolder

REM -----------------------------------------------------------------------------
Property Get InstallFolder() As String
''' Return the installation folder of LibreOffice

Const cstThisSub = "FileSystem.getInstallFolder"

SF_Utils._EnterFunction(cstThisSub)
InstallFolder = SF_FileSystem._GetConfigFolder("inst")
SF_Utils._ExitFunction(cstThisSub)

End Property ' ScriptForge.SF_FileSystem.InstallFolder

REM -----------------------------------------------------------------------------
Property Get ObjectType As String
''' Only to enable object representation
ObjectType = "SF_FileSystem"
End Property ' ScriptForge.SF_FileSystem.ObjectType

REM -----------------------------------------------------------------------------
Property Get ServiceName As String
''' Internal use
ServiceName = "ScriptForge.FileSystem"
End Property ' ScriptForge.SF_FileSystem.ServiceName

REM -----------------------------------------------------------------------------
Property Get TemplatesFolder() As String
''' Return the folder defined in the LibreOffice paths options as intended for templates files

Dim sPath As String   ' Template property of com.sun.star.util.PathSettings
Const cstThisSub = "FileSystem.getTemplatesFolder"

SF_Utils._EnterFunction(cstThisSub)
sPath = SF_Utils._GetUNOService("PathSettings").Template
TemplatesFolder = SF_FileSystem._ConvertFromUrl(Split(sPath, ";")(0) & "/")
SF_Utils._ExitFunction(cstThisSub)

End Property ' ScriptForge.SF_FileSystem.TemplatesFolder

REM -----------------------------------------------------------------------------
Property Get TemporaryFolder() As String
''' Return the folder defined in the LibreOffice paths options as intended for temporary files

Const cstThisSub = "FileSystem.getTemporaryFolder"

SF_Utils._EnterFunction(cstThisSub)
TemporaryFolder = SF_FileSystem._GetConfigFolder("temp")
SF_Utils._ExitFunction(cstThisSub)

End Property ' ScriptForge.SF_FileSystem.TemporaryFolder

REM -----------------------------------------------------------------------------
Property Get UserTemplatesFolder() As String
''' Return the folder defined in the LibreOffice paths options as intended for User templates files

Dim sPath As String   ' Template_writable property of com.sun.star.util.PathSettings
Const cstThisSub = "FileSystem.getUserTemplatesFolder"

SF_Utils._EnterFunction(cstThisSub)
sPath = SF_Utils._GetUNOService("PathSettings").Template_writable
UserTemplatesFolder = SF_FileSystem._ConvertFromUrl(sPath & "/")
SF_Utils._ExitFunction(cstThisSub)

End Property ' ScriptForge.SF_FileSystem.UserTemplatesFolder

REM ===================================================================== METHODS

REM -----------------------------------------------------------------------------
Public Function BuildPath(Optional ByVal FolderName As Variant _
       , Optional ByVal Name As Variant _
       ) As String
''' Combines a folder path and the name of a file and returns the combination with a valid path separator
''' Inserts an additional path separator between the foldername and the name, only if necessary
''' Args:
'''  FolderName: Path with which Name is combined. Path need not specify an existing folder
'''  Name: To be appended to the existing path.
''' Returns:
'''  The path concatenated with the file name after insertion of a path separator, if necessary
''' Example:
'''  Dim a As String
'''      FSO.FileNaming = "SYS"
'''   a = FSO.BuildPath("C:\Windows", "Notepad.exe") returns C:\Windows\Notepad.exe

Dim sBuild As String   ' Return value
Dim sFile As String    ' Alias for Name
Const cstFileProtocol = "file:///"
Const cstThisSub = "FileSystem.BuildPath"
Const cstSubArgs = "FolderName, Name"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
sBuild = ""

Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._ValidateFile(FolderName, "FolderName") Then GoTo Finally
  If Not SF_Utils._Validate(Name, "Name", V_STRING) Then GoTo Finally
End If
FolderName = SF_FileSystem._ConvertToUrl(FolderName)

Try:
' Add separator if necessary. FolderName is now in URL notation
If Len(FolderName) > 0 Then
  If Right(FolderName, 1) <> "/" Then sBuild = FolderName & "/" Else sBuild = FolderName
Else
  sBuild = cstFileProtocol
End If
' Encode the file name
sFile = ConvertToUrl(Name)
' Some file names produce http://file.name.suffix/
If Left(sFile, 7) = "http://" Then sFile = cstFileProtocol & Mid(sFile, 8, Len(sFile) - 8)
' Combine both parts
If Left(sFile, Len(cstFileProtocol)) = cstFileProtocol Then sBuild = sBuild & Mid(sFile, Len(cstFileProtocol) + 1) Else sBuild = sBuild & sFile

Finally:
BuildPath = SF_FileSystem._ConvertFromUrl(sBuild)
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_FileSystem.BuildPath

REM -----------------------------------------------------------------------------
Public Function CompareFiles(Optional ByVal FileName1 As Variant _
        , Optional ByVal FileName2 As Variant _
        , Optional ByVal CompareContents As Variant _
        )
''' Compare 2 files and return True if they seem identical
''' The comparison may be based on the file attributes, like modification time,
''' or on their contents.
''' The method is not supported for document's internal file systems.
''' Args:
'''  FileName1: The 1st file to compare
'''  FileName2: The 2nd file to compare
'''  CompareContents: When True, the contents of the files are compared. Default = False
''' Returns:
'''  True when the files seem identical
''' Exceptions:
'''  UNKNOWNFILEERROR  One of the files does not exist
'''  FILESYSTEMERROR   The method is not applicable on document's file systems
''' Example:
'''  FSO.FileNaming = "SYS"
'''  MsgBox FSO.CompareFiles("C:\myFile1.txt", "C:\myFile2.txt", CompareContents := True)

Dim bCompare As Boolean   ' Return value
Dim sFile As String    ' Alias of FileName1 and 2
Dim iFile As Integer   ' 1 or 2
Const cstPyHelper = "$" & "_SF_FileSystem__CompareFiles"

Const cstThisSub = "FileSystem.CompareFiles"
Const cstSubArgs = "FileName1, FileName2, [CompareContents=False]"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bCompare = False

Check:
If IsMissing(CompareContents) Or IsEmpty(CompareContents) Then CompareContents = False
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._ValidateFile(FileName1, "FileName1", False) Then GoTo Finally
  If Not SF_Utils._ValidateFile(FileName2, "FileName2", False) Then GoTo Finally
  If Not SF_Utils._Validate(CompareContents, "CompareContents", V_BOOLEAN) Then GoTo Finally
End If
' Do the files exist ? Otherwise raise error
sFile = FileName1 : iFile = 1
If Not SF_FileSystem.FileExists(sFile) Then GoTo CatchNotExists
sFile = FileName2 : iFile = 2
If Not SF_FileSystem.FileExists(sFile) Then GoTo CatchNotExists

sFile = FileName1 : iFile = 1
If SF_FileSystem._IsDocFileSystem(sFile) Then GoTo CatchNotSupported
sFile = FileName2 : iFile = 2
If SF_FileSystem._IsDocFileSystem(sFile) Then GoTo CatchNotSupported

Try:
With ScriptForge.SF_Session
  bCompare = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _
       , _ConvertFromUrl(FileName1) _
       , _ConvertFromUrl(FileName2) _
       , CompareContents)
End With

Finally:
CompareFiles = bCompare
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
CatchNotExists:
SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName" & iFile, sFile)
GoTo Finally
CatchNotSupported:
SF_Exception.RaiseFatal(FILESYSTEMERROR,  "FileName" & iFile, Split(cstThisSub, ".")(1), sFile)
GoTo Finally
End Function    '   ScriptForge.SF_FileSystem.CompareFiles

REM -----------------------------------------------------------------------------
Public Function CopyFile(Optional ByVal Source As Variant _
       , Optional ByVal Destination As Variant _
       , Optional ByVal Overwrite As Variant _
       ) As Boolean
''' Copies one or more files from one location to another
''' Args:
'''  Source: FileName or NamePattern which can include wildcard characters, for one or more files to be copied
'''  Destination: FileName where the single Source file is to be copied
'''     or FolderName where the multiple files from Source are to be copied
'''       If FolderName does not exist, it is created
'''     Anyway, wildcard characters are not allowed in Destination
'''  Overwrite: If True (default), files may be overwritten
'''   CopyFile will fail if Destination has the read-only attribute set, regardless of the value of Overwrite.
''' Returns:
'''  True if at least one file has been copied
'''  False if an error occurred
'''   An error also occurs if a source using wildcard characters doesn't match any files.
'''   The method stops on the first error it encounters
'''   No attempt is made to roll back or undo any changes made before an error occurs
''' Exceptions:
'''  UNKNOWNFILEERROR   Source does not exist
'''  UNKNOWNFOLDERERROR   Source folder or Destination folder does not exist
'''  NOFILEMATCHERROR  No file matches Source containing wildcards
'''  NOTAFOLDERERROR    Destination is a file, not a folder
'''  NOTAFILEERROR    Destination is a folder, not a file
'''  OVERWRITEERROR    Destination can not be overwritten
'''  READONLYERROR    Destination has its read-only attribute set
''' Example:
'''  FSO.FileNaming = "SYS"
'''  FSO.CopyFile("C:\Windows\*.*", "C:\Temp\", Overwrite := False)  ' Only files are copied, subfolders are not

Dim bCopy As Boolean   ' Return value

Const cstThisSub = "FileSystem.CopyFile"
Const cstSubArgs = "Source, Destination, [Overwrite=True]"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bCopy = False

Check:
If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = True
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._ValidateFile(Source, "Source", True) Then GoTo Finally
  If Not SF_Utils._ValidateFile(Destination, "Destination", False) Then GoTo Finally
  If Not SF_Utils._Validate(Overwrite, "Overwrite", V_BOOLEAN) Then GoTo Finally
End If

Try:
bCopy = SF_FileSystem._CopyMove("CopyFile", Source, Destination, Overwrite)

Finally:
CopyFile = bCopy
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function    '   ScriptForge.SF_FileSystem.CopyFile

REM -----------------------------------------------------------------------------
Public Function CopyFolder(Optional ByVal Source As Variant _
       , Optional ByVal Destination As Variant _
       , Optional ByVal Overwrite As Variant _
       ) As Boolean
''' Copies one or more folders from one location to another
''' Args:
'''  Source: FolderName or NamePattern which can include wildcard characters, for one or more folders to be copied
'''  Destination: FolderName where the single Source folder is to be copied
'''     or FolderName where the multiple folders from Source are to be copied
'''       If FolderName does not exist, it is created
'''     Anyway, wildcard characters are not allowed in Destination
'''  Overwrite: If True (default), folders and their content may be overwritten
'''   CopyFile will fail if Destination has the read-only attribute set, regardless of the value of Overwrite.
''' Returns:
'''  True if at least one folder has been copied
'''  False if an error occurred
'''   An error also occurs if a source using wildcard characters doesn't match any folders.
'''   The method stops on the first error it encounters
'''   No attempt is made to roll back or undo any changes made before an error occurs
''' Exceptions:
'''  UNKNOWNFILEERROR   Source does not exist
'''  UNKNOWNFOLDERERROR   Source folder or Destination folder does not exist
'''  NOFILEMATCHERROR  No file matches Source containing wildcards
'''  NOTAFOLDERERROR    Destination is a file, not a folder
'''  OVERWRITEERROR    Destination can not be overwritten
'''  READONLYERROR    Destination has its read-only attribute set
''' Example:
'''  FSO.FileNaming = "SYS"
'''  FSO.CopyFolder("C:\Windows\*", "C:\Temp\", Overwrite := False)

Dim bCopy As Boolean   ' Return value

Const cstThisSub = "FileSystem.CopyFolder"
Const cstSubArgs = "Source, Destination, [Overwrite=True]"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bCopy = False

Check:
If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = True
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._ValidateFile(Source, "Source", True) Then GoTo Finally
  If Not SF_Utils._ValidateFile(Destination, "Destination", False) Then GoTo Finally
  If Not SF_Utils._Validate(Overwrite, "Overwrite", V_BOOLEAN) Then GoTo Finally
End If

Try:
bCopy = SF_FileSystem._CopyMove("CopyFolder", Source, Destination, Overwrite)

Finally:
CopyFolder = bCopy
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function    '   ScriptForge.SF_FileSystem.CopyFolder

REM -----------------------------------------------------------------------------
Public Function CreateFolder(Optional ByVal FolderName As Variant) As Boolean
''' Return True if the given folder name could be created successfully
''' The parent folder does not need to exist beforehand
''' Args:
'''  FolderName: a string representing the folder to create. It must not exist
''' Returns:
'''  True if FolderName is a valid folder name, does not exist and creation was successful
'''  False otherwise including when FolderName is a file
''' Exceptions:
'''  FOLDERCREATIONERROR  FolderName is an existing folder or file
''' Example:
'''  FSO.FileNaming = "SYS"
'''  FSO.CreateFolder("C:\NewFolder\")

Dim bCreate As Boolean   ' Return value
Dim oSfa As Object    ' com.sun.star.ucb.SimpleFileAccess

Const cstThisSub = "FileSystem.CreateFolder"
Const cstSubArgs = "FolderName"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bCreate = False

Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._ValidateFile(FolderName, "FolderName") Then GoTo Finally
End If

Try:
Set oSfa = SF_Utils._GetUnoService("FileAccess")
If SF_FileSystem.FolderExists(FolderName) Then GoTo CatchExists
If SF_FileSystem.FileExists(FolderName) Then GoTo CatchExists
oSfa.createFolder(SF_FileSystem._ConvertToUrl(FolderName))
bCreate = True

Finally:
CreateFolder = bCreate
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
CatchExists:
SF_Exception.RaiseFatal(FOLDERCREATIONERROR, "FolderName", FolderName)
GoTo Finally
End Function    '   ScriptForge.SF_FileSystem.CreateFolder

REM -----------------------------------------------------------------------------
Public Function CreateTextFile(Optional ByVal FileName As Variant _
        , Optional ByVal Overwrite As Variant _
        , Optional ByVal Encoding As Variant _
        ) As Object
''' Creates a specified file and returns a TextStream object that can be used to write to the file
''' Args:
'''  FileName: Identifies the file to create
'''  Overwrite: Boolean value that indicates if an existing file can be overwritten (default = True)
'''  Encoding: The character set that should be used
'''    Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml
'''    Note that LibreOffice does not implement all existing sets
'''    Default = UTF-8
''' Returns:
'''  An instance of the SF_TextStream class representing the opened file or a Null object if an error occurred
'''  It doesn't check either if the given encoding is implemented in LibreOffice
''' Exceptions:
'''  OVERWRITEERROR   File exists, creation impossible
''' Example:
'''  Dim myFile As Object
'''      FSO.FileNaming = "SYS"
'''   Set myFile = FSO.CreateTextFile("C:\Temp\ThisFile.txt", Overwrite := True)

Dim oTextStream As Object  ' Return value
Const cstThisSub = "FileSystem.CreateTextFile"
Const cstSubArgs = "FileName, [Overwrite=True], [Encoding=""UTF-8""]"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
Set oTextStream = Nothing

Check:
If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = True
If IsMissing(Encoding) Or IsEmpty(Encoding) Then Encoding = "UTF-8"
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
  If Not SF_Utils._Validate(Overwrite, "Overwrite", V_BOOLEAN) Then GoTo Finally
  If Not SF_Utils._Validate(Encoding, "Encoding", V_STRING) Then GoTo Finally
End If

With SF_FileSystem
  If .FileExists(FileName) Then
   If Overwrite Then .DeleteFile(FileName) Else GoTo CatchOverWrite
  End If

Try:
  Set oTextStream = .OpenTextFile(FileName, .ForWriting, Create := True, Encoding := Encoding)
End With

Finally:
Set CreateTextFile = oTextStream
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
CatchOverWrite:
SF_Exception.RaiseFatal(OVERWRITEERROR, "FileName", FileName)
GoTo Finally
End Function ' ScriptForge.SF_FileSystem.CreateTextFile

REM -----------------------------------------------------------------------------
Public Function DeleteFile(Optional ByVal FileName As Variant) As Boolean
''' Deletes one or more files
''' Args:
'''  FileName: FileName or NamePattern which can include wildcard characters, for one or more files to be deleted
''' Returns:
'''  True if at least one file has been deleted
'''  False if an error occurred
'''   An error also occurs if a FileName using wildcard characters doesn't match any files.
'''   The method stops on the first error it encounters
'''   No attempt is made to roll back or undo any changes made before an error occurs
''' Exceptions:
'''  UNKNOWNFILEERROR   FileName does not exist
'''  NOFILEMATCHERROR  No file matches FileName containing wildcards
'''  NOTAFILEERROR    Argument is a folder, not a file
''' Example:
'''  FSO.FileNaming = "SYS"
'''  FSO.DeleteFile("C:\Temp\*.*")  ' Only files are deleted, subfolders are not

Dim bDelete As Boolean   ' Return value

Const cstThisSub = "FileSystem.DeleteFile"
Const cstSubArgs = "FileName"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bDelete = False

Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._ValidateFile(FileName, "FileName", True) Then GoTo Finally
End If

Try:
bDelete = SF_FileSystem._Delete("DeleteFile", FileName)

Finally:
DeleteFile = bDelete
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function    '   ScriptForge.SF_FileSystem.DeleteFile

REM -----------------------------------------------------------------------------
Public Function DeleteFolder(Optional ByVal FolderName As Variant) As Boolean
''' Deletes one or more Folders
''' Args:
'''  FolderName: FolderName or NamePattern which can include wildcard characters, for one or more Folders to be deleted
''' Returns:
'''  True if at least one folder has been deleted
'''  False if an error occurred
'''   An error also occurs if a FolderName using wildcard characters doesn't match any folders.
'''   The method stops on the first error it encounters
'''   No attempt is made to roll back or undo any changes made before an error occurs
''' Exceptions:
'''  UNKNOWNFOLDERERROR   FolderName does not exist
'''  NOFILEMATCHERROR  No folder matches FolderName containing wildcards
'''  NOTAFOLDERERROR    Argument is a file, not a folder
''' Example:
'''  FSO.FileNaming = "SYS"
'''  FSO.DeleteFolder("C:\Temp\*")  ' Only folders are deleted, files in the parent folder are not

Dim bDelete As Boolean   ' Return value

Const cstThisSub = "FileSystem.DeleteFolder"
Const cstSubArgs = "FolderName"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bDelete = False

Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._ValidateFile(FolderName, "FolderName", True) Then GoTo Finally
End If

Try:
bDelete = SF_FileSystem._Delete("DeleteFolder", FolderName)

Finally:
DeleteFolder = bDelete
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function    '   ScriptForge.SF_FileSystem.DeleteFolder

REM -----------------------------------------------------------------------------
Public Function ExtensionFolder(Optional ByVal Extension As Variant) As String
''' Return the folder where the given extension is installed. The argument must
''' be in the list of extensions provided by the SF_Platform.Extensions property
''' Args:
'''  Extension: a valid extension name
''' Returns:
'''  The requested folder using the FileNaming notation
''' Example:
'''  MsgBox FSO.ExtensionFolder("apso.python.script.organizer")

Dim sFolder As String   ' Return value
Static vExtensions As Variant ' Cached list of existing extension names
Dim oPackage As Object   ' /singletons/com.sun.star.deployment.PackageInformationProvider
Const cstThisSub = "FileSystem.ExtensionFolder"
Const cstSubArgs = "Extension"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
sFolder = ""

Check:
If IsEmpty(vExtensions) Then vExtensions = SF_Platform.Extensions
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._Validate(Extension, "Extension", V_STRING, vExtensions, True) Then GoTo Finally
End If

Try:
' Search an individual folder
Set oPackage = SF_Utils._GetUnoService("PackageInformationProvider")
sFolder = oPackage.getPackageLocation(Extension)

Finally:
ExtensionFolder = SF_FileSystem._ConvertFromUrl(sFolder)
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_FileSystem.ExtensionFolder

REM -----------------------------------------------------------------------------
Public Function FileExists(Optional ByVal FileName As Variant) As Boolean
''' Return True if the given file exists
''' Args:
'''  FileName: a string representing a file
''' Returns:
'''  True if FileName is a valid File name and it exists
'''  False otherwise including when FileName is a folder
''' Example:
'''  FSO.FileNaming = "SYS"
'''  If FSO.FileExists("C:\Notepad.exe") Then ...

Dim bExists As Boolean   ' Return value
Dim oSfa As Object    ' com.sun.star.ucb.SimpleFileAccess

Const cstThisSub = "FileSystem.FileExists"
Const cstSubArgs = "FileName"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bExists = False

Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
End If
FileName = SF_FileSystem._ConvertToUrl(FileName)

Try:
Set oSfa = SF_Utils._GetUnoService("FileAccess")
bExists = oSfa.exists(FileName) And Not oSfa.isFolder(FileName)

Finally:
FileExists = bExists
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function    '   ScriptForge.SF_FileSystem.FileExists

REM -----------------------------------------------------------------------------
Public Function Files(Optional ByVal FolderName As Variant _
      , Optional ByVal Filter As Variant _
      , Optional ByVal IncludeSubfolders As Variant _
      ) As Variant
''' Return an array of the FileNames stored in the given folder. The folder must exist
''' Subfolders may be optionally explored too.
''' If the number of files exceeds a reasonable amount (> 1000 ?), the process time may become long.
''' Args:
'''  FolderName: the folder to explore
'''  Filter: contains wildcards ("?" and "*") to limit the list to the relevant files (default = "")
'''  IncludeSubfolders: when True (default = False), subfolders are explored too.
''' Returns:
'''  An array of strings, each entry is the FileName of an existing file
''' Exceptions:
'''  UNKNOWNFOLDERERROR  Folder does not exist
'''  NOTAFOLDERERROR   FolderName is a file, not a folder
''' Example:
'''  Dim a As Variant
'''   FSO.FileNaming = "SYS"
'''   a = FSO.Files("C:\Windows\", IncludeSubfolders := True)

Dim vFiles As Variant   ' Return value
Dim oSfa As Object    ' com.sun.star.ucb.SimpleFileAccess
Dim sFilesColl As String  ' cstSEPARATOR delimited string of list of files (FileNaming notation)
Dim i As Long

Const cstThisSub = "FileSystem.Files"
Const cstSubArgs = "FolderName, [Filter=""""], [IncludeSubfolders=False]"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
vFiles = Array()

Check:
If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = ""
If IsMissing(IncludeSubfolders) Or IsEmpty(IncludeSubfolders) Then IncludeSubfolders = False
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._ValidateFile(FolderName, "FolderName") Then GoTo Finally
  If Not SF_Utils._Validate(Filter, "Filter", V_STRING) Then GoTo Finally
  If Not SF_Utils._Validate(IncludeSubfolders, "IncludeSubfolders", V_BOOLEAN) Then GoTo Finally
End If
If SF_FileSystem.FileExists(FolderName) Then GoTo CatchFile    ' Must not be a file
If Not SF_FileSystem.FolderExists(FolderName) Then GoTo CatchFolder  ' Folder must exist

Try:
sFilesColl = ""
Set oSfa = SF_Utils._GetUnoService("FileAccess")
SF_FileSystem._ScanFolder(cstFiles, sFilesColl, FolderName, oSfa, Filter, IncludeSubfolders)

If Len(sFilesColl) > Len(cstSEPARATOR) Then vFiles() = Split(Mid(sFilesColl, Len(cstSEPARATOR) + 1), cstSEPARATOR)

Finally:
Files = vFiles
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
CatchFile:
SF_Exception.RaiseFatal(NOTAFOLDERERROR, "FolderName", FolderName)
GoTo Finally
CatchFolder:
SF_Exception.RaiseFatal(UNKNOWNFOLDERERROR, "FolderName", FolderName)
GoTo Finally
End Function    '   ScriptForge.SF_FileSystem.Files

REM -----------------------------------------------------------------------------
Public Function FolderExists(Optional ByVal FolderName As Variant) As Boolean
''' Return True if the given folder name exists
''' Args:
'''  FolderName: a string representing a folder
''' Returns:
'''  True if FolderName is a valid folder name and it exists
'''  False otherwise including when FolderName is a file
''' Example:
'''  FSO.FileNaming = "SYS"
'''  If FSO.FolderExists("C:\") Then ...

Dim bExists As Boolean   ' Return value
Dim oSfa As Object    ' com.sun.star.ucb.SimpleFileAccess

Const cstThisSub = "FileSystem.FolderExists"
Const cstSubArgs = "FolderName"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bExists = False

Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._ValidateFile(FolderName, "FolderName") Then GoTo Finally
End If
FolderName = SF_FileSystem._ConvertToUrl(FolderName)

Try:
Set oSfa = SF_Utils._GetUnoService("FileAccess")
bExists = oSfa.isFolder(FolderName)

Finally:
FolderExists = bExists
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function    '   ScriptForge.SF_FileSystem.FolderExists

REM -----------------------------------------------------------------------------
Public Function GetBaseName(Optional ByVal FileName As Variant) As String
''' Returns the BaseName part of the last component of a File- or FolderName, without its extension
''' The method does not check for the existence of the specified file or folder
''' Args:
'''  FileName: Path and file name
''' Returns:
'''  The BaseName of the given argument in native operating system format. May be empty
''' Example:
'''  Dim a As String
'''      FSO.FileNaming = "SYS"
'''   a = FSO.GetBaseName("C:\Windows\Notepad.exe") returns Notepad

Dim sBase As String    ' Return value
Dim sExt As String    ' Extension
Dim sName As String    ' Last component of FileName
Dim vName As Variant   ' Array of trunks of sName
Const cstThisSub = "FileSystem.GetBaseName"
Const cstSubArgs = "FileName"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
sBase = ""

Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
End If

Try:
sName = SF_FileSystem.GetName(FileName)
If Len(sName) > 0 Then
  If InStr(sName, ".") > 0 Then
   vName = Split(sName, ".")
   sExt = vName(UBound(vName))
   sBase = Left(sName, Len(sName) - Len(sExt) - 1)
  Else
   sBase = sName
  End If
End If

Finally:
GetBaseName = sBase
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_FileSystem.GetBaseName

REM -----------------------------------------------------------------------------
Public Function GetExtension(Optional ByVal FileName As Variant) As String
''' Returns the extension part of a File- or FolderName, without the dot (.).
''' The method does not check for the existence of the specified file or folder
''' Args:
'''  FileName: Path and file name
''' Returns:
'''  The extension without a leading dot. May be empty
''' Example:
'''  Dim a As String
'''      FSO.FileNaming = "SYS"
'''   a = FSO.GetExtension("C:\Windows\Notepad.exe") returns exe

Dim sExt As String    ' Return value
Dim sName As String    ' Last component of FileName
Dim vName As Variant   ' Array of trunks of sName
Const cstThisSub = "FileSystem.GetExtension"
Const cstSubArgs = "FileName"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
sExt = ""

Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
End If

Try:
sName = SF_FileSystem.GetName(FileName)
If Len(sName) > 0 And InStr(sName, ".") > 0 Then
  vName = Split(sName, ".")
  sExt = vName(UBound(vName))
End If

Finally:
GetExtension = sExt
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_FileSystem.GetExtension

REM -----------------------------------------------------------------------------
Public Function GetFileLen(Optional ByVal FileName As Variant) As Currency
''' Return file size in bytes with four decimals '''
''' Args:
'''  FileName: a string representing a file
''' Returns:
'''  File size if FileName exists
'''  0 when FileName belongs to a document's internal file systems.
''' Exceptions:
'''  UNKNOWNFILEERROR The file does not exist or is a folder
''' Example:
'''  Print SF_FileSystem.GetFileLen("C:\pagefile.sys")

Dim curSize As Currency   ' Return value
Const cstPyHelper = "$" & "_SF_FileSystem__GetFilelen"
Const cstThisSub = "FileSystem.GetFileLen"
Const cstSubArgs = "FileName"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
curSize = 0

Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
End If

Try:
If SF_FileSystem.FileExists(FileName) Then
  If SF_FileSystem._IsDocFileSystem(FileName) Then
   curSize = 0
  Else
   With ScriptForge.SF_Session
    curSize = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _
        , _ConvertFromUrl(FileName))
   End With
  End If
Else
  GoTo CatchNotExists
End If

Finally:
GetFileLen = curSize
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
CatchNotExists:
SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", FileName)
GoTo Finally
End Function    '   ScriptForge.SF_FileSystem.GetFileLen

REM -----------------------------------------------------------------------------
Public Function GetFileModified(Optional ByVal FileName As Variant) As Variant
''' Returns the last modified date for the given file
''' The method is not supported for document's internal file systems.
''' Args:
'''  FileName: a string representing an existing file
''' Returns:
'''  The modification date and time as a Basic Date
''' Exceptions:
'''  UNKNOWNFILEERROR The file does not exist or is a folder
'''  FILESYSTEMERROR  The method is not applicable on document's file systems
''' Example:
'''  Dim a As Date
'''   FSO.FileNaming = "SYS"
'''   a = FSO.GetFileModified("C:\Temp\myDoc.odt")

Dim dModified As Date   ' Return value
Dim oModified As New com.sun.star.util.DateTime
Dim oSfa As Object    ' com.sun.star.ucb.SimpleFileAccess

Const cstThisSub = "FileSystem.GetFileModified"
Const cstSubArgs = "FileName"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
dModified = 0

Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
End If
If SF_FileSystem._IsDocFileSystem(FileName) Then GoTo CatchNotSupported

Try:
Set oSfa = SF_Utils._GetUnoService("FileAccess")
If SF_FileSystem.FileExists(FileName) Then
  FileName = SF_FileSystem._ConvertToUrl(FileName)
  Set oModified = oSfa.getDateTimeModified(FileName)
  dModified = CDateFromUnoDateTime(oModified)
Else
  GoTo CatchNotExists
End If

Finally:
GetFileModified = dModified
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
CatchNotExists:
SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", FileName)
GoTo Finally
CatchNotSupported:
SF_Exception.RaiseFatal(FILESYSTEMERROR, "FileName", Split(cstThisSub, ".")(1), FileName)
GoTo Finally
End Function    '   ScriptForge.SF_FileSystem.GetFileModified

REM -----------------------------------------------------------------------------
Public Function GetName(Optional ByVal FileName As Variant) As String
''' Returns the last component of a File- or FolderName
''' The method does not check for the existence of the specified file or folder
''' Args:
'''  FileName: Path and file name
''' Returns:
'''  The last component of the full file name in native operating system format
''' Example:
'''  Dim a As String
'''      FSO.FileNaming = "SYS"
'''   a = FSO.GetName("C:\Windows\Notepad.exe") returns Notepad.exe

Dim sName As String    ' Return value
Dim vFile As Variant   ' Array of components
Const cstThisSub = "FileSystem.GetName"
Const cstSubArgs = "FileName"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
sName = ""

Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
End If
FileName = SF_FileSystem._ConvertToUrl(FileName)

Try:
If Len(FileName) > 0 Then
  If Right(FileName, 1) = "/" Then FileName = Left(FileName, Len(FileName) - 1)
  vFile = Split(FileName, "/")
  sName = ConvertFromUrl(vFile(UBound(vFile))) ' Always in SYS format
End If

Finally:
GetName = sName
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_FileSystem.GetName

REM -----------------------------------------------------------------------------
Public Function GetParentFolderName(Optional ByVal FileName As Variant) As String
''' Returns a string containing the name of the parent folder of the last component in a specified File- or FolderName
''' The method does not check for the existence of the specified file or folder
''' Args:
'''  FileName: Path and file name
''' Returns:
'''  A FolderName including its final path separator
''' Example:
'''  Dim a As String
'''      FSO.FileNaming = "SYS"
'''   a = FSO.GetParentFolderName("C:\Windows\Notepad.exe") returns C:\Windows\

Dim sFolder As String   ' Return value
Dim sName As String    ' Last component of FileName
Dim vFile As Variant   ' Array of file components
Const cstThisSub = "FileSystem.GetParentFolderName"
Const cstSubArgs = "FileName"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
sFolder = ""

Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
End If
FileName = SF_FileSystem._ConvertToUrl(FileName)

Try:
If Right(FileName, 1) = "/" Then FileName = Left(FileName, Len(FileName) - 1)
vFile = Split(FileName, "/")
If UBound(vFile) >= 0 Then vFile(UBound(vFile)) = ""
sFolder = Join(vFile, "/")
If sFolder = "" Or Right(sFolder, 1) <> "/" Then sFolder = sFolder & "/"

Finally:
GetParentFolderName = SF_FileSystem._ConvertFromUrl(sFolder)
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_FileSystem.GetParentFolderName

REM -----------------------------------------------------------------------------
Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
''' Return the actual value of the given property
''' Args:
'''  PropertyName: the name of the property as a string
''' Returns:
'''  The actual value of the property
''' Exceptions
'''  ARGUMENTERROR  The property does not exist

Const cstThisSub = "FileSystem.GetProperty"
Const cstSubArgs = "PropertyName"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
GetProperty = Null

Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
End If

Try:
Select Case UCase(PropertyName)
  Case UCase("ConfigFolder")   : GetProperty = ConfigFolder
  Case UCase("ExtensionsFolder")  : GetProperty = ExtensionsFolder
  Case UCase("FileNaming")   : GetProperty = FileNaming
  Case UCase("HomeFolder")   : GetProperty = HomeFolder
  Case UCase("InstallFolder")   : GetProperty = InstallFolder
  Case UCase("TemplatesFolder")  : GetProperty = TemplatesFolder
  Case UCase("TemporaryFolder")  : GetProperty = TemporaryFolder
  Case UCase("UserTemplatesFolder") : GetProperty = UserTemplatesFolder
  Case Else
End Select

Finally:
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function ' ScriptForge.SF_FileSystem.GetProperty

REM -----------------------------------------------------------------------------
Public Function GetTempName(Optional ByVal Extension As Variant) As String
''' Returns a randomly generated temporary file name that is useful for performing
''' operations that require a temporary file : the method does not create any file
''' Args:
''' Returns:
'''  A FileName as a String that can be used f.i. with CreateTextFile()
'''  The FileName has as suffix the given extension.
''' Example:
'''  Dim a As String
'''   FSO.FileNaming = "SYS"
'''   a = FSO.GetTempName("txt") ' /tmp/SF_123456.txt
'''   a = FSO.GetTempName()  ' /tmp/SF_234567

Dim sFile As String    ' Return value
Dim sExtension As String  ' The given extension preceded by a dot
Dim lRandom As Long    ' Random integer

Const cstThisSub = "FileSystem.GetTempName"
Const cstSubArgs = ""

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
sFile = ""

Check:
If IsMissing(Extension) Or IsEmpty(Extension) Then Extension = ""
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._Validate(Extension, "Extension", V_STRING) Then GoTo Catch
End If

Try:
lRandom = SF_Session.ExecuteCalcFunction("RANDBETWEEN.NV", 1, 999999)
If Len(Extension) > 0 Then sExtension = "." & Extension Else sExtension = ""
sFile = SF_FileSystem.TemporaryFolder & "SF_" & Right("000000" & lRandom, 6) & sExtension

Finally:
GetTempName = SF_FileSystem._ConvertFromUrl(sFile)
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function    '   ScriptForge.SF_FileSystem.GetTempName

REM -----------------------------------------------------------------------------
Public Function HashFile(Optional ByVal FileName As Variant _
       , Optional ByVal Algorithm As Variant _
       ) As String
''' Return an hexadecimal string representing a checksum of the given file
''' Next algorithms are supported: MD5, SHA1, SHA224, SHA256, SHA384 and SHA512
''' The method is not supported for document's internal file systems.
''' Args:
'''  FileName: a string representing a file
'''  Algorithm: The hashing algorithm to use
''' Returns:
'''  The requested checksum as a string. Hexadecimal digits are lower-cased
'''  A zero-length string when an error occurred
''' Exceptions:
'''  UNKNOWNFILEERROR The file does not exist or is a folder
'''  FILESYSTEMERROR  The method is not applicable on document's file systems
''' Example:
'''  Print SF_FileSystem.HashFile("C:\pagefile.sys", "MD5")

Dim sHash As String    ' Return value
Const cstPyHelper = "$" & "_SF_FileSystem__HashFile"
Const cstThisSub = "FileSystem.HashFile"
Const cstSubArgs = "FileName, Algorithm=""MD5""|""SHA1""|""SHA224""|""SHA256""|""SHA384""|""SHA512"""

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
sHash = ""

Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
  If Not SF_Utils._Validate(Algorithm, "Algorithm", V_STRING _
     , Array("MD5", "SHA1", "SHA224", "SHA256", "SHA384", "SHA512")) Then GoTo Finally
End If
If SF_FileSystem._IsDocFileSystem(FileName) Then GoTo CatchNotSupported

Try:
If SF_FileSystem.FileExists(FileName) Then
  With ScriptForge.SF_Session
   sHash = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _
       , _ConvertFromUrl(FileName), LCase(Algorithm))
  End With
Else
  GoTo CatchNotExists
End If

Finally:
HashFile = sHash
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
CatchNotExists:
SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", FileName)
GoTo Finally
CatchNotSupported:
SF_Exception.RaiseFatal(FILESYSTEMERROR, "FileName", Split(cstThisSub, ".")(1), FileName)
GoTo Finally
End Function    '   ScriptForge.SF_FileSystem.HashFile

REM -----------------------------------------------------------------------------
Public Function Methods() As Variant
''' Return the list or methods of the FileSystem service as an array

Methods = Array("BuildPath" _
     , "CompareFiles" _
     , "CopyFile" _
     , "CopyFolder" _
     , "CreateFolder" _
     , "CreateTextFile" _
     , "DeleteFile" _
     , "DeleteFolder" _
     , "ExtensionFolder" _
     , "FileExists" _
     , "Files" _
     , "FolderExists" _
     , "GetBaseName" _
     , "GetExtension" _
     , "GetFileLen" _
     , "GetFileModified" _
     , "GetName" _
     , "GetParentFolderName" _
     , "GetTempName" _
     , "HashFile" _
     , "MoveFile" _
     , "MoveFolder" _
     , "Normalize" _
     , "OpenTextFile" _
     , "PickFile" _
     , "PickFolder" _
     , "SubFolders" _
     )

End Function ' ScriptForge.SF_FileSystem.Methods

REM -----------------------------------------------------------------------------
Public Function MoveFile(Optional ByVal Source As Variant _
       , Optional ByVal Destination As Variant _
       ) As Boolean
''' Moves one or more files from one location to another
''' Args:
'''  Source: FileName or NamePattern which can include wildcard characters, for one or more files to be moved
'''  Destination: FileName where the single Source file is to be moved
'''       If Source and Destination have the same parent folder MoveFile amounts to renaming the Source
'''     or FolderName where the multiple files from Source are to be moved
'''       If FolderName does not exist, it is created
'''     Anyway, wildcard characters are not allowed in Destination
''' Returns:
'''  True if at least one file has been moved
'''  False if an error occurred
'''   An error also occurs if a source using wildcard characters doesn't match any files.
'''   The method stops on the first error it encounters
'''   No attempt is made to roll back or undo any changes made before an error occurs
''' Exceptions:
'''  UNKNOWNFILEERROR   Source does not exist
'''  UNKNOWNFOLDERERROR   Source folder or Destination folder does not exist
'''  NOFILEMATCHERROR  No file matches Source containing wildcards
'''  NOTAFOLDERERROR    Destination is a file, not a folder
'''  NOTAFILEERROR    Destination is a folder, not a file
'''  OVERWRITEERROR    Destination can not be overwritten
''' Example:
'''  FSO.FileNaming = "SYS"
'''  FSO.MoveFile("C:\Temp1\*.*", "C:\Temp2\")  ' Only files are moved, subfolders are not

Dim bMove As Boolean   ' Return value

Const cstThisSub = "FileSystem.MoveFile"
Const cstSubArgs = "Source, Destination"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bMove = False

Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._ValidateFile(Source, "Source", True) Then GoTo Finally
  If Not SF_Utils._ValidateFile(Destination, "Destination", False) Then GoTo Finally
End If

Try:
bMove = SF_FileSystem._CopyMove("MoveFile", Source, Destination, False)

Finally:
MoveFile = bMove
SF_Utils._ExitFunction(cstThisSub)
Exit Function
Catch:
GoTo Finally
End Function    '   ScriptForge.SF_FileSystem.MoveFile

REM -----------------------------------------------------------------------------
Public Function MoveFolder(Optional ByVal Source As Variant _
       , Optional ByVal Destination As Variant _
       ) As Boolean
''' Moves one or more folders from one location to another
''' Args:
'''  Source: FolderName or NamePattern which can include wildcard characters, for one or more folders to be moved
'''  Destination: FolderName where the single Source folder is to be moved
'''       FolderName must not exist
'''     or FolderName where the multiple folders from Source are to be moved
'''       If FolderName does not exist, it is created
'''     Anyway, wildcard characters are not allowed in Destination
''' Returns:
'''  True if at least one folder has been moved
'''  False if an error occurred
'''   An error also occurs if a source using wildcard characters doesn't match any folders.
'''   The method stops on the first error it encounters
'''   No attempt is made to roll back or undo any changes made before an error occurs
''' Exceptions:
'''  UNKNOWNFILEERROR   Source does not exist
'''  UNKNOWNFOLDERERROR   Source folder or Destination folder does not exist
'''  NOFILEMATCHERROR  No file matches Source containing wildcards
'''  NOTAFOLDERERROR    Destination is a file, not a folder
'''  OVERWRITEERROR    Destination can not be overwritten
''' Example:
'''  FSO.FileNaming = "SYS"
'''  FSO.MoveFolder("C:\Temp1\*", "C:\Temp2\")

Dim bMove As Boolean   ' Return value

Const cstThisSub = "FileSystem.MoveFolder"
Const cstSubArgs = "Source, Destination"

If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
bMove = False

Check:
If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not SF_Utils._ValidateFile(Source, "Source", True) Then GoTo Finally
--> --------------------

--> maximum size reached

--> --------------------

SSL SF_FileSystem.xba Sprache: unbekannt

[ Verzeichnis aufwärts0.130unsichere Verbindung ]