| 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084 |
- <?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")
- '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
- 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 installed extensions
- 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 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 Date
- ''' 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 "ConfigFolder" : GetProperty = ConfigFolder
- Case "ExtensionsFolder" : GetProperty = ExtensionsFolder
- Case "FileNaming" : GetProperty = FileNaming
- Case "HomeFolder" : GetProperty = HomeFolder
- Case "InstallFolder" : GetProperty = InstallFolder
- Case "TemplatesFolder" : GetProperty = TemplatesFolder
- Case "TemporaryFolder" : GetProperty = TemporaryFolder
- Case "UserTemplatesFolder" : GetProperty = UserTemplatesFolder
- Case Else
- End Select
- Finally:
- SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' ScriptForge.SF_FileSystem.GetProperty
- REM -----------------------------------------------------------------------------
- Public Function GetTempName() As String
- ''' Returns a randomly generated temporary file name that is useful for performing
- ''' operations that require a temporary file : the method does not create any file
- ''' Args:
- ''' Returns:
- ''' A FileName as a String that can be used f.i. with CreateTextFile()
- ''' The FileName does not have any suffix
- ''' Example:
- ''' Dim a As String
- ''' FSO.FileNaming = "SYS"
- ''' a = FSO.GetTempName() & ".txt"
- Dim sFile As String ' Return value
- Dim sTempDir As String ' The path to a temporary folder
- Dim lRandom As Long ' Random integer
- Const cstThisSub = "FileSystem.GetTempName"
- Const cstSubArgs = ""
- If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sFile = ""
- Check:
- SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
- Try:
- lRandom = SF_Session.ExecuteCalcFunction("RANDBETWEEN", 1, 999999)
- sFile = SF_FileSystem.TemporaryFolder & "SF_" & Right("000000" & lRandom, 6)
- Finally:
- GetTempName = SF_FileSystem._ConvertFromUrl(sFile)
- SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' ScriptForge.SF_FileSystem.GetTempName
- REM -----------------------------------------------------------------------------
- Public Function HashFile(Optional ByVal FileName As Variant _
- , Optional ByVal Algorithm As Variant _
- ) As String
- ''' Return an hexadecimal string representing a checksum of the given file
- ''' Next algorithms are supported: MD5, SHA1, SHA224, SHA256, SHA384 and SHA512
- ''' Args:
- ''' FileName: a string representing a file
- ''' Algorithm: The hashing algorithm to use
- ''' Returns:
- ''' The requested checksum as a string. Hexadecimal digits are lower-cased
- ''' A zero-length string when an error occurred
- ''' Exceptions:
- ''' UNKNOWNFILEERROR The file does not exist of is a folder
- ''' Example:
- ''' Print SF_FileSystem.HashFile("C:\pagefile.sys", "MD5")
- Dim sHash As String ' Return value
- Const cstPyHelper = "$" & "_SF_FileSystem__HashFile"
- Const cstThisSub = "FileSystem.HashFile"
- Const cstSubArgs = "FileName, Algorithm=""MD5""|""SHA1""|""SHA224""|""SHA256""|""SHA384""|""SHA512"""
- If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sHash = ""
- Check:
- If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
- If Not SF_Utils._Validate(Algorithm, "Algorithm", V_STRING _
- , Array("MD5", "SHA1", "SHA224", "SHA256", "SHA384", "SHA512")) Then GoTo Finally
- End If
- Try:
- If SF_FileSystem.FileExists(FileName) Then
- With ScriptForge.SF_Session
- sHash = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _
- , _ConvertFromUrl(FileName), LCase(Algorithm))
- End With
- Else
- GoTo CatchNotExists
- End If
- Finally:
- HashFile = sHash
- SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- CatchNotExists:
- SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", FileName)
- GoTo Finally
- End Function ' ScriptForge.SF_FileSystem.HashFile
- REM -----------------------------------------------------------------------------
- Public Function Methods() As Variant
- ''' Return the list or methods of the FileSystem service as an array
- Methods = Array("BuildPath" _
- , "CompareFiles" _
- , "CopyFile" _
- , "CopyFolder" _
- , "CreateFolder" _
- , "CreateTextFile" _
- , "DeleteFile" _
- , "DeleteFolder" _
- , "FileExists" _
- , "Files" _
- , "FolderExists" _
- , "GetBaseName" _
- , "GetExtension" _
- , "GetFileLen" _
- , "GetFileModified" _
- , "GetName" _
- , "GetParentFolderName" _
- , "GetTempName" _
- , "HashFile" _
- , "MoveFile" _
- , "MoveFolder" _
- , "OpenTextFile" _
- , "PickFile" _
- , "PickFolder" _
- , "SubFolders" _
- )
- End Function ' ScriptForge.SF_FileSystem.Methods
- REM -----------------------------------------------------------------------------
- Public Function MoveFile(Optional ByVal Source As Variant _
- , Optional ByVal Destination As Variant _
- ) As Boolean
- ''' Moves one or more files from one location to another
- ''' Args:
- ''' Source: FileName or NamePattern which can include wildcard characters, for one or more files to be moved
- ''' Destination: FileName where the single Source file is to be moved
- ''' If Source and Destination have the same parent folder MoveFile amounts to renaming the Source
- ''' or FolderName where the multiple files from Source are to be moved
- ''' If FolderName does not exist, it is created
- ''' Anyway, wildcard characters are not allowed in Destination
- ''' Returns:
- ''' True if at least one file has been moved
- ''' False if an error occurred
- ''' An error also occurs if a source using wildcard characters doesn't match any files.
- ''' The method stops on the first error it encounters
- ''' No attempt is made to roll back or undo any changes made before an error occurs
- ''' Exceptions:
- ''' UNKNOWNFILEERROR Source does not exist
- ''' UNKNOWNFOLDERERROR Source folder or Destination folder does not exist
- ''' NOFILEMATCHERROR No file matches Source containing wildcards
- ''' NOTAFOLDERERROR Destination is a file, not a folder
- ''' NOTAFILEERROR Destination is a folder, not a file
- ''' OVERWRITEERROR Destination can not be overwritten
- ''' Example:
- ''' FSO.FileNaming = "SYS"
- ''' FSO.MoveFile("C:\Temp1\*.*", "C:\Temp2\") ' Only files are moved, subfolders are not
- Dim bMove As Boolean ' Return value
- Const cstThisSub = "FileSystem.MoveFile"
- Const cstSubArgs = "Source, Destination"
- If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bMove = False
- Check:
- If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not SF_Utils._ValidateFile(Source, "Source", True) Then GoTo Finally
- If Not SF_Utils._ValidateFile(Destination, "Destination", False) Then GoTo Finally
- End If
- Try:
- bMove = SF_FileSystem._CopyMove("MoveFile", Source, Destination, False)
- Finally:
- MoveFile = bMove
- SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' ScriptForge.SF_FileSystem.MoveFile
- REM -----------------------------------------------------------------------------
- Public Function MoveFolder(Optional ByVal Source As Variant _
- , Optional ByVal Destination As Variant _
- ) As Boolean
- ''' Moves one or more folders from one location to another
- ''' Args:
- ''' Source: FolderName or NamePattern which can include wildcard characters, for one or more folders to be moved
- ''' Destination: FolderName where the single Source folder is to be moved
- ''' FolderName must not exist
- ''' or FolderName where the multiple folders from Source are to be moved
- ''' If FolderName does not exist, it is created
- ''' Anyway, wildcard characters are not allowed in Destination
- ''' Returns:
- ''' True if at least one folder has been moved
- ''' False if an error occurred
- ''' An error also occurs if a source using wildcard characters doesn't match any folders.
- ''' The method stops on the first error it encounters
- ''' No attempt is made to roll back or undo any changes made before an error occurs
- ''' Exceptions:
- ''' UNKNOWNFILEERROR Source does not exist
- ''' UNKNOWNFOLDERERROR Source folder or Destination folder does not exist
- ''' NOFILEMATCHERROR No file matches Source containing wildcards
- ''' NOTAFOLDERERROR Destination is a file, not a folder
- ''' OVERWRITEERROR Destination can not be overwritten
- ''' Example:
- ''' FSO.FileNaming = "SYS"
- ''' FSO.MoveFolder("C:\Temp1\*", "C:\Temp2\")
- Dim bMove As Boolean ' Return value
- Const cstThisSub = "FileSystem.MoveFolder"
- Const cstSubArgs = "Source, Destination"
- If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- bMove = False
- Check:
- If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not SF_Utils._ValidateFile(Source, "Source", True) Then GoTo Finally
- If Not SF_Utils._ValidateFile(Destination, "Destination", False) Then GoTo Finally
- End If
- Try:
- bMove = SF_FileSystem._CopyMove("MoveFolder", Source, Destination, False)
- Finally:
- MoveFolder = bMove
- SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' ScriptForge.SF_FileSystem.MoveFolder
- REM -----------------------------------------------------------------------------
- Public Function OpenTextFile(Optional ByVal FileName As Variant _
- , Optional ByVal IOMode As Variant _
- , Optional ByVal Create As Variant _
- , Optional ByVal Encoding As Variant _
- ) As Object
- ''' Opens a specified file and returns a TextStream object that can be used to read from, write to, or append to the file
- ''' Args:
- ''' FileName: Identifies the file to open
- ''' IOMode: Indicates input/output mode. Can be one of three constants: ForReading, ForWriting, or ForAppending
- ''' Create: Boolean value that indicates whether a new file can be created if the specified filename doesn't exist.
- ''' The value is True if a new file and its parent folders may be created; False if they aren't created (default)
- ''' Encoding: The character set that should be used
- ''' Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml
- ''' Note that LibreOffice does not implement all existing sets
- ''' Default = UTF-8
- ''' Returns:
- ''' An instance of the SF_TextStream class representing the opened file or a Null object if an error occurred
- ''' The method does not check if the file is really a text file
- ''' It doesn't check either if the given encoding is implemented in LibreOffice nor if it is the right one
- ''' Exceptions:
- ''' UNKNOWNFILEERROR File does not exist
- ''' Example:
- ''' Dim myFile As Object
- ''' FSO.FileNaming = "SYS"
- ''' Set myFile = FSO.OpenTextFile("C:\Temp\ThisFile.txt", FSO.ForReading)
- ''' If Not IsNull(myFile) Then ' ... Go ahead with reading text lines
- Dim oTextStream As Object ' Return value
- Dim bExists As Boolean ' File to open does exist
- Const cstThisSub = "FileSystem.OpenTextFile"
- Const cstSubArgs = "FileName, [IOMode=1], [Create=False], [Encoding=""UTF-8""]"
- If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- Set oTextStream = Nothing
- Check:
- With SF_FileSystem
- If IsMissing(IOMode) Or IsEmpty(IOMode) Then IOMode = ForReading
- If IsMissing(Create) Or IsEmpty(Create) Then Create = False
- If IsMissing(Encoding) Or IsEmpty(Encoding) Then Encoding = "UTF-8"
- If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally
- If Not SF_Utils._Validate(IOMode, "IOMode", V_NUMERIC _
- , Array(ForReading, ForWriting, ForAppending)) _
- Then GoTo Finally
- If Not SF_Utils._Validate(Create, "Create", V_BOOLEAN) Then GoTo Finally
- If Not SF_Utils._Validate(Encoding, "Encoding", V_STRING) Then GoTo Finally
- End If
- bExists = .FileExists(FileName)
- Select Case IOMode
- Case ForReading : If Not bExists Then GoTo CatchNotExists
- Case Else : If Not bExists And Not Create Then GoTo CatchNotExists
- End Select
- If IOMode = ForAppending And Not bExists Then IOMode = ForWriting
- End With
- Try:
- ' Create and initialize TextStream class instance
- Set oTextStream = New SF_TextStream
- With oTextStream
- .[Me] = oTextStream
- .[_Parent] = SF_FileSystem
- ._FileName = SF_FileSystem._ConvertToUrl(FileName)
- ._IOMode = IOMode
- ._Encoding = Encoding
- ._FileExists = bExists
- ._Initialize()
- End With
- Finally:
- Set OpenTextFile = oTextStream
- SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- CatchNotExists:
- SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", FileName)
- GoTo Finally
- End Function ' ScriptForge.SF_FileSystem.OpenTextFile
- REM -----------------------------------------------------------------------------
- Public Function PickFile(Optional ByVal DefaultFile As Variant _
- , Optional ByVal Mode As Variant _
- , Optional ByVal Filter As Variant _
- ) As String
- ''' Returns the file selected with a FilePicker dialog box
- ''' The mode, OPEN or SAVE, and the filter may be preset
- ''' If mode = SAVE and the picked file exists, a warning message will be displayed
- ''' Modified from Andrew Pitonyak's Base Macro Programming §10.4
- ''' Args:
- ''' DefaultFile: Folder part: the FolderName from which to start. Default = the last selected folder
- ''' File part: the default file to open or save
- ''' Mode: "OPEN" (input file) or "SAVE" (output file)
- ''' Filter: by default only files having the given suffix will be displayed. Default = all suffixes
- ''' The filter combo box will contain the given SuffixFilter (if not "*") and "*.*"
- ''' Returns:
- ''' The selected FileName in URL format or "" if the dialog was cancelled
- ''' Example:
- ''' FSO.FileNaming = "SYS"
- ''' FSO.PickFile("C:\", "OPEN", "txt") ' Only *.txt files are displayed
- Dim oFileDialog As Object ' com.sun.star.ui.dialogs.FilePicker
- Dim oFileAccess As object ' com.sun.star.ucb.SimpleFileAccess
- Dim oPath As Object ' com.sun.star.util.PathSettings
- Dim iAccept As Integer ' Result of dialog execution
- Dim sInitPath As String ' Current working directory
- Dim sBaseFile As String
- Dim iMode As Integer ' Numeric alias for SelectMode
- Dim sFile As String ' Return value
- Const cstThisSub = "FileSystem.PickFile"
- Const cstSubArgs = "[DefaultFile=""""], [Mode=""OPEN""|""SAVE""],[Filter=""""]"
- If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sFile = ""
- Check:
- If IsMissing(DefaultFile) Or IsEmpty(DefaultFile) Then DefaultFile = ""
- If IsMissing(Mode) Or IsEmpty(Mode) Then Mode = "OPEN"
- If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = ""
- If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not SF_Utils._ValidateFile(DefaultFile, "DefaultFile", , True) Then GoTo Finally
- If Not SF_Utils._Validate(Mode, "Mode", V_STRING, Array("OPEN", "SAVE")) Then GoTo Finally
- If Not SF_Utils._Validate(Filter, "Filter", V_STRING) Then GoTo Finally
- End If
- DefaultFile = SF_FileSystem._ConvertToUrl(DefaultFile)
- Try:
- ' Derive numeric equivalent of the Mode argument: https://api.libreoffice.org/docs/idl/ref/TemplateDescription_8idl.html
- With com.sun.star.ui.dialogs.TemplateDescription
- If Mode = "OPEN" Then iMode = .FILEOPEN_SIMPLE Else iMode = .FILESAVE_AUTOEXTENSION
- End With
- ' Activate the filepicker dialog
- Set oFileDialog = SF_Utils._GetUNOService("FilePicker")
- With oFileDialog
- .Initialize(Array(iMode))
- ' Set filters
- If Len(Filter) > 0 Then .appendFilter("*." & Filter, "*." & Filter) ' Twice: required by API
- .appendFilter("*.*", "*.*")
- If Len(Filter) > 0 Then .setCurrentFilter("*." & Filter) Else .setCurrentFilter("*.*")
- ' Set initial folder
- If Len(DefaultFile) = 0 Then ' TODO: SF_Session.WorkingFolder
- Set oPath = SF_Utils._GetUNOService("PathSettings")
- sInitPath = oPath.Work ' Probably My Documents
- Else
- sInitPath = SF_FileSystem._ParseUrl(ConvertToUrl(DefaultFile)).Path
- End If
- ' Set default values
- Set oFileAccess = SF_Utils._GetUNOService("FileAccess")
- If oFileAccess.exists(sInitPath) Then .SetDisplayDirectory(sInitPath)
- sBaseFile = SF_FileSystem.GetName(DefaultFile)
- .setDefaultName(sBaseFile)
- ' Get selected file
- iAccept = .Execute()
- If iAccept = com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then sFile = .getSelectedFiles()(0)
- End With
- Finally:
- PickFile = SF_FileSystem._ConvertFromUrl(sFile)
- SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' ScriptForge.SF_FileSystem.PickFile
- REM -----------------------------------------------------------------------------
- Public Function PickFolder(Optional ByVal DefaultFolder As variant _
- , Optional ByVal FreeText As Variant _
- ) As String
- ''' Display a FolderPicker dialog box
- ''' Args:
- ''' DefaultFolder: the FolderName from which to start. Default = the last selected folder
- ''' FreeText: text to display in the dialog. Default = ""
- ''' Returns:
- ''' The selected FolderName in URL or operating system format
- ''' The zero-length string if the dialog was cancelled
- ''' Example:
- ''' FSO.FileNaming = "SYS"
- ''' FSO.PickFolder("C:\", "Choose a folder or press Cancel")
- Dim oFolderDialog As Object ' com.sun.star.ui.dialogs.FolderPicker
- Dim iAccept As Integer ' Value returned by the dialog (OK, Cancel, ..)
- Dim sFolder As String ' Return value '
- Const cstThisSub = "FileSystem.PickFolder"
- Const cstSubArgs = "[DefaultFolder=""""], [FreeText=""""]"
- If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- sFolder = ""
- Check:
- If IsMissing(DefaultFolder) Or IsEmpty(DefaultFolder) Then DefaultFolder = ""
- If IsMissing(FreeText) Or IsEmpty(FreeText) Then FreeText = ""
- If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not SF_Utils._ValidateFile(DefaultFolder, "DefaultFolder", , True) Then GoTo Finally
- If Not SF_Utils._Validate(FreeText, "FreeText", V_STRING) Then GoTo Finally
- End If
- DefaultFolder = SF_FileSystem._ConvertToUrl(DefaultFolder)
- Try:
- Set oFolderDialog = SF_Utils._GetUNOService("FolderPicker")
- If Not IsNull(oFolderDialog) Then
- With oFolderDialog
- If Len(DefaultFolder) > 0 Then .DisplayDirectory = ConvertToUrl(DefaultFolder)
- .Description = FreeText
- iAccept = .Execute()
- ' https://api.libreoffice.org/docs/idl/ref/ExecutableDialogResults_8idl.html
- If iAccept = com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then
- .DisplayDirectory = .Directory ' Set the next default initial folder to the selected one
- sFolder = .Directory & "/"
- End If
- End With
- End If
- Finally:
- PickFolder = SF_FileSystem._ConvertFromUrl(sFolder)
- SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' ScriptForge.SF_FileSystem.PickFolder
- REM -----------------------------------------------------------------------------
- Public Function Properties() As Variant
- ''' Return the list or properties of the FileSystem module as an array
- Properties = Array( _
- "ConfigFolder" _
- , "ExtensionsFolder" _
- , "FileNaming" _
- , "HomeFolder" _
- , "InstallFolder" _
- , "TemplatesFolder" _
- , "TemporaryFolder" _
- , "UserTemplatesFolder" _
- )
- End Function ' ScriptForge.SF_FileSystem.Properties
- REM -----------------------------------------------------------------------------
- Public Function SetProperty(Optional ByVal PropertyName As Variant _
- , Optional ByRef Value As Variant _
- ) As Boolean
- ''' Set a new value to the given property
- ''' Args:
- ''' PropertyName: the name of the property as a string
- ''' Value: its new value
- ''' Exceptions
- ''' ARGUMENTERROR The property does not exist
- Const cstThisSub = "FileSystem.SetProperty"
- Const cstSubArgs = "PropertyName, Value"
- If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- SetProperty = False
- Check:
- If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
- End If
- Try:
- Select Case UCase(PropertyName)
- Case Else
- End Select
- Finally:
- SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- End Function ' ScriptForge.SF_FileSystem.SetProperty
- REM -----------------------------------------------------------------------------
- Public Function SubFolders(Optional ByVal FolderName As Variant _
- , Optional ByVal Filter As Variant _
- ) As Variant
- ''' Return an array of the FolderNames stored in the given folder. The folder must exist
- ''' Args:
- ''' FolderName: the folder to explore
- ''' Filter: contains wildcards ("?" and "*") to limit the list to the relevant folders (default = "")
- ''' Returns:
- ''' An array of strings, each entry is the FolderName of an existing folder
- ''' Exceptions:
- ''' UNKNOWNFOLDERERROR Folder does not exist
- ''' NOTAFOLDERERROR FolderName is a file, not a folder
- ''' Example:
- ''' Dim a As Variant
- ''' FSO.FileNaming = "SYS"
- ''' a = FSO.SubFolders("C:\Windows\")
- Dim vSubFolders As Variant ' Return value
- Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
- Dim sFolderName As String ' URL lias for FolderName
- Dim sFolder As String ' Single folder
- Dim i As Long
- Const cstThisSub = "FileSystem.SubFolders"
- Const cstSubArgs = "FolderName, [Filter=""""]"
- If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
- vSubFolders = Array()
- Check:
- If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = ""
- If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
- If Not SF_Utils._ValidateFile(FolderName, "FolderName") Then GoTo Finally
- If Not SF_Utils._Validate(Filter, "Filter", V_STRING) Then GoTo Finally
- End If
- sFolderName = SF_FileSystem._ConvertToUrl(FolderName)
- If SF_FileSystem.FileExists(FolderName) Then GoTo CatchFile ' Must not be a file
- If Not SF_FileSystem.FolderExists(FolderName) Then GoTo CatchFolder ' Folder must exist
- Try:
- ' Get SubFolders
- Set oSfa = SF_Utils._GetUnoService("FileAccess")
- vSubFolders = oSfa.getFolderContents(sFolderName, True)
- ' List includes files; remove them or adjust notations of folders
- For i = 0 To UBound(vSubFolders)
- sFolder = SF_FileSystem._ConvertFromUrl(vSubFolders(i) & "/")
- If SF_FileSystem.FileExists(sFolder) Then vSubFolders(i) = "" Else vSubFolders(i) = sFolder
- ' Reduce list to those passing the filter
- If Len(Filter) > 0 And Len(vSubFolders(i)) > 0 Then
- sFolder = SF_FileSystem.GetName(vSubFolders(i))
- If Not SF_String.IsLike(sFolder, Filter) Then vSubFolders(i) = ""
- End If
- Next i
- vSubFolders = SF_Array.TrimArray(vSubFolders)
- Finally:
- SubFolders = vSubFolders
- SF_Utils._ExitFunction(cstThisSub)
- Exit Function
- Catch:
- GoTo Finally
- CatchFile:
- SF_Exception.RaiseFatal(NOTAFOLDERERROR, "FolderName", FolderName)
- GoTo Finally
- CatchFolder:
- SF_Exception.RaiseFatal(UNKNOWNFOLDERERROR, "FolderName", FolderName)
- GoTo Finally
- End Function ' ScriptForge.SF_FileSystem.SubFolders
- REM =========================================================== PRIVATE FUNCTIONS
- REM -----------------------------------------------------------------------------
- Private Function _ConvertFromUrl(psFile) As String
- ''' Execute the builtin ConvertFromUrl function only when relevant
- ''' i.e. when FileNaming (how arguments and return values are provided) = "SYS"
- ''' Called at the bottom of methods returning file names
- ''' Remark: psFile might contain wildcards
- Const cstQuestion = "$QUESTION$", cstStar = "$STAR$" ' Special tokens to replace wildcards
- If SF_FileSystem.FileNaming = "SYS" Then
- _ConvertFromUrl = Replace(Replace( _
- ConvertFromUrl(Replace(Replace(psFile, "?", cstQuestion), "*", cstStar)) _
- , cstQuestion, "?"), cstStar, "*")
- Else
- _ConvertFromUrl = psFile
- End If
- End Function ' ScriptForge.FileSystem._ConvertFromUrl
- REM -----------------------------------------------------------------------------
- Private Function _ConvertToUrl(psFile) As String
- ''' Execute the builtin ConvertToUrl function only when relevant
- ''' i.e. when FileNaming (how arguments and return values are provided) = "SYS"
- ''' Called at the top of methods receiving file names as arguments
- ''' Remark: psFile might contain wildcards
- If SF_FileSystem.FileNaming = "URL" Then
- _ConvertToUrl = psFile
- Else
- ' ConvertToUrl encodes "?"
- _ConvertToUrl = Replace(ConvertToUrl(psFile), "%3F", "?")
- End If
- End Function ' ScriptForge.FileSystem._ConvertToUrl
- REM -----------------------------------------------------------------------------
- Private Function _CopyMove(psMethod As String _
- , psSource As String _
- , psDestination As String _
- , pbOverWrite As Boolean _
- ) As Boolean
- ''' Checks the arguments and executes the given method
- ''' Args:
- ''' psMethod: CopyFile/CopyFolder or MoveFile/MoveFolder
- ''' psSource: Either File/FolderName
- ''' or NamePattern which can include wildcard characters, for one or more files/folders to be copied
- ''' psDestination: FileName or FolderName for copy/move of a single file/folder
- ''' Otherwise a destination FolderName. If it does not exist, it is created
- ''' pbOverWrite: If True, files/folders may be overwritten
- ''' Must be False for Move operations
- ''' Next checks are done:
- ''' With wildcards (multiple files/folders):
- ''' - Parent folder of source must exist
- ''' - Destination must not be a file
- ''' - Parent folder of Destination must exist
- ''' - If the Destination folder does not exist a new folder is created,
- ''' - At least one file matches the wildcards expression
- ''' - Destination files/folder must not exist if pbOverWrite = False
- ''' - Destination files/folders must not have the read-only attribute set
- ''' - Destination files must not be folders, destination folders must not be files
- ''' Without wildcards (single file/folder):
- ''' - Source file/folder must exist and be a file/folder
- ''' - Parent folder of Destination must exist
- ''' - Destination must not be an existing folder/file
- ''' - Destination file/folder must not exist if pbOverWrite = False
- ''' - Destination file must not have the read-only attribute set
- Dim bCopyMove As Boolean ' Return value
- Dim bCopy As Boolean ' True if Copy, False if Move
- Dim bFile As Boolean ' True if File, False if Folder
- Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
- Dim bWildCards As Boolean ' True if wildcards found in Source
- Dim bCreateFolder As Boolean ' True when the destination folder should be created
- Dim bDestExists As Boolean ' True if destination exists
- Dim sSourceUrl As String ' Alias for Source
- Dim sDestinationUrl As String ' Alias for Destination
- Dim sDestinationFile As String ' Destination FileName
- Dim sParentFolder As String ' Parent folder of Source
- Dim vFiles As Variant ' Array of candidates for copy/move
- Dim sFile As String ' Single file/folder
- Dim sName As String ' Name (last component) of file
- Dim i As Long
- ' Error handling left to calling routine
- bCopyMove = False
- bCopy = ( Left(psMethod, 4) = "Copy" )
- bFile = ( Right(psMethod, 4) = "File" )
- bWildCards = ( InStr(psSource, "*") + InStr(psSource, "?") + InStr(psSource, "%3F") > 0 ) 'ConvertToUrl() converts sometimes "?" to "%3F"
- bDestExists = False
- With SF_FileSystem
- Check:
- If bWildCards Then
- sParentFolder = .GetParentFolderName(psSource)
- If Not .FolderExists(sParentFolder) Then GoTo CatchNoMatch
- If .FileExists(psDestination) Then GoTo CatchFileNotFolder
- If Not .FolderExists(.GetParentFolderName(psDestination)) Then GoTo CatchDestFolderNotExists
- bCreateFolder = Not .FolderExists(psDestination)
- Else
- Select Case bFile
- Case True ' File
- If Not .FileExists(psSource) Then GoTo CatchFileNotExists
- If Not .FolderExists(.GetParentFolderName(psDestination)) Then GoTo CatchSourceFolderNotExists
- If .FolderExists(psDestination) Then GoTo CatchFolderNotFile
- bDestExists = .FileExists(psDestination)
- If pbOverWrite = False And bDestExists = True Then GoTo CatchDestinationExists
- bCreateFolder = False
- Case False ' Folder
- If Not .FolderExists(psSource) Then GoTo CatchSourceFolderNotExists
- If Not .FolderExists(.GetParentFolderName(psDestination)) Then GoTo CatchDestFolderNotExists
- If .FileExists(psDestination) Then GoTo CatchFileNotFolder
- bDestExists = .FolderExists(psDestination)
- If pbOverWrite = False And bDestExists Then GoTo CatchDestinationExists
- bCreateFolder = Not bDestExists
- End Select
- End If
- Try:
- Set oSfa = SF_Utils._GetUnoService("FileAccess")
- If bWildCards Then
- If bFile Then vFiles = .Files(sParentFolder, .GetName(psSource)) Else vFiles = .SubFolders(sParentFolder, .GetName(psSource))
- If UBound(vFiles) < 0 Then GoTo CatchNoMatch
- ' Go through the candidates
- If bCreateFolder Then .CreateFolder(psDestination)
- For i = 0 To UBound(vFiles)
- sFile = vFiles(i)
- sDestinationFile = .BuildPath(psDestination, .GetName(sFile))
- If bFile Then bDestExists = .FileExists(sDestinationFile) Else bDestExists = .FolderExists(sDestinationFile)
- If pbOverWrite = False Then
- If bDestExists Then GoTo CatchDestinationExists
- If .FolderExists(sDestinationFile) Then GoTo CatchDestinationExists
- End If
- sSourceUrl = ._ConvertToUrl(sFile)
- sDestinationUrl = ._ConvertToUrl(sDestinationFile)
- If bDestExists Then
- If oSfa.isReadOnly(sDestinationUrl) Then GoTo CatchDestinationReadOnly
- End If
- Select Case bCopy
- Case True : oSfa.copy(sSourceUrl, sDestinationUrl)
- Case False : oSfa.move(sSourceUrl, sDestinationUrl)
- End Select
- Next i
- Else
- sSourceUrl = ._ConvertToUrl(psSource)
- sDestinationUrl = ._ConvertToUrl(psDestination)
- If bDestExists Then
- If oSfa.isReadOnly(sDestinationUrl) Then GoTo CatchDestinationReadOnly
- End If
- If bCreateFolder Then .CreateFolder(psDestination)
- Select Case bCopy
- Case True : oSfa.copy(sSourceUrl, sDestinationUrl)
- Case False : oSfa.move(sSourceUrl, sDestinationUrl)
- End Select
- End If
- End With
- bCopyMove = True
- Finally:
- _CopyMove = bCopyMove
- Exit Function
- CatchFileNotExists:
- SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "Source", psSource)
- GoTo Finally
- CatchSourceFolderNotExists:
- SF_Exception.RaiseFatal(UNKNOWNFOLDERERROR, "Source", psSource)
- GoTo Finally
- CatchDestFolderNotExists:
- SF_Exception.RaiseFatal(UNKNOWNFOLDERERROR, "Destination", psDestination)
- GoTo Finally
- CatchFolderNotFile:
- SF_Exception.RaiseFatal(NOTAFILEERROR, "Destination", psDestination)
- GoTo Finally
- CatchDestinationExists:
- SF_Exception.RaiseFatal(OVERWRITEERROR, "Destination", psDestination)
- GoTo Finally
- CatchNoMatch:
- SF_Exception.RaiseFatal(NOFILEMATCHERROR, "Source", psSource)
- GoTo Finally
- CatchFileNotFolder:
- SF_Exception.RaiseFatal(NOTAFOLDERERROR, "Destination", psDestination)
- GoTo Finally
- CatchDestinationReadOnly:
- SF_Exception.RaiseFatal(READONLYERROR, "Destination", Iif(bWildCards, sDestinationFile, psDestination))
- GoTo Finally
- End Function ' ScriptForge.SF_FileSystem._CopyMove
- REM -----------------------------------------------------------------------------
- Public Function _CountTextLines(ByVal psFileName As String _
- , Optional ByVal pbIncludeBlanks As Boolean _
- ) As Long
- ''' Convenient function to count the number of lines in a textfile
- ''' Args:
- ''' psFileName: the file in FileNaming notation
- ''' pbIncludeBlanks: if True (default), zero-length lines are included
- ''' Returns:
- ''' The number of lines, f.i. to ease array sizing. -1 if file reading error
- Dim lLines As Long ' Return value
- Dim oFile As Object ' File handler
- Dim sLine As String ' The last line read
- Try:
- lLines = 0
- If IsMissing(pbIncludeBlanks) Then pbIncludeBlanks = True
- Set oFile = SF_FileSystem.OpenTextFile(psFileName, ForReading)
- With oFile
- If Not IsNull(oFile) Then
- Do While Not .AtEndOfStream
- sLine = .ReadLine()
- lLines = lLines + Iif(Len(sLine) > 0 Or pbIncludeBlanks, 1, 0)
- Loop
- End If
- .CloseFile()
- Set oFile = .Dispose()
- End With
- Finally:
- _CountTextLines = lLines
- Exit Function
- End Function ' ScriptForge.SF_FileSystem._CountTextLines
- REM -----------------------------------------------------------------------------
- Private Function _Delete(psMethod As String _
- , psFile As String _
- ) As Boolean
- ''' Checks the argument and executes the given psMethod
- ''' Args:
- ''' psMethod: CopyFile/CopyFolder or MoveFile/MoveFolder
- ''' psFile: Either File/FolderName
- ''' or NamePattern which can include wildcard characters, for one or more files/folders to be deleted
- ''' Next checks are done:
- ''' With wildcards (multiple files/folders):
- ''' - Parent folder of File must exist
- ''' - At least one file matches the wildcards expression
- ''' - Files or folders to delete must not have the read-only attribute set
- ''' Without wildcards (single file/folder):
- ''' - File/folder must exist and be a file/folder
- ''' - A file or folder to delete must not have the read-only attribute set
- Dim bDelete As Boolean ' Return value
- Dim bFile As Boolean ' True if File, False if Folder
- Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
- Dim bWildCards As Boolean ' True if wildcards found in File
- Dim sFileUrl As String ' Alias for File
- Dim sParentFolder As String ' Parent folder of File
- Dim vFiles As Variant ' Array of candidates for deletion
- Dim sFile As String ' Single file/folder
- Dim sName As String ' Name (last component) of file
- Dim i As Long
- ' Error handling left to calling routine
- bDelete = False
- bFile = ( Right(psMethod, 4) = "File" )
- bWildCards = ( InStr(psFile, "*") + InStr(psFile, "?") + InStr(psFile, "%3F") > 0 ) 'ConvertToUrl() converts sometimes "?" to "%3F"
- With SF_FileSystem
- Check:
- If bWildCards Then
- sParentFolder = .GetParentFolderName(psFile)
- If Not .FolderExists(sParentFolder) Then GoTo CatchNoMatch
- Else
- Select Case bFile
- Case True ' File
- If .FolderExists(psFile) Then GoTo CatchFolderNotFile
- If Not .FileExists(psFile) Then GoTo CatchFileNotExists
- Case False ' Folder
- If .FileExists(psFile) Then GoTo CatchFileNotFolder
- If Not .FolderExists(psFile) Then GoTo CatchFolderNotExists
- End Select
- End If
- Try:
- Set oSfa = SF_Utils._GetUnoService("FileAccess")
- If bWildCards Then
- If bFile Then vFiles = .Files(sParentFolder) Else vFiles = .SubFolders(sParentFolder)
- ' Select candidates
- For i = 0 To UBound(vFiles)
- If Not SF_String.IsLike(.GetName(vFiles(i)), .GetName(psFile)) Then vFiles(i) = ""
- Next i
- vFiles = SF_Array.TrimArray(vFiles)
- If UBound(vFiles) < 0 Then GoTo CatchNoMatch
- ' Go through the candidates
- For i = 0 To UBound(vFiles)
- sFile = vFiles(i)
- sFileUrl = ._ConvertToUrl(sFile)
- If oSfa.isReadOnly(sFileUrl) Then GoTo CatchReadOnly
- oSfa.kill(sFileUrl)
- Next i
- Else
- sFileUrl = ._ConvertToUrl(psFile)
- If oSfa.isReadOnly(sFileUrl) Then GoTo CatchReadOnly
- oSfa.kill(sFileUrl)
- End If
- End With
- bDelete = True
- Finally:
- _Delete = bDelete
- Exit Function
- CatchFolderNotExists:
- SF_Exception.RaiseFatal(UNKNOWNFOLDERERROR, "FolderName", psFile)
- GoTo Finally
- CatchFileNotExists:
- SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", psFile)
- GoTo Finally
- CatchFolderNotFile:
- SF_Exception.RaiseFatal(NOTAFILEERROR, "FileName", psFile)
- GoTo Finally
- CatchNoMatch:
- SF_Exception.RaiseFatal(NOFILEMATCHERROR, Iif(bFile, "FileName", "FolderName"), psFile)
- GoTo Finally
- CatchFileNotFolder:
- SF_Exception.RaiseFatal(NOTAFOLDERERROR, "FolderName", psFile)
- GoTo Finally
- CatchReadOnly:
- SF_Exception.RaiseFatal(READONLYERROR, Iif(bFile, "FileName", "FolderName"), Iif(bWildCards, sFile, psFile))
- GoTo Finally
- End Function ' ScriptForge.SF_FileSystem._Delete
- REM -----------------------------------------------------------------------------
- Private Function _GetConfigFolder(ByVal psFolder As String) As String
- ''' Returns one of next configuration folders: see https://api.libreoffice.org/docs/idl/ref/servicecom_1_1sun_1_1star_1_1util_1_1PathSubstitution.html
- ''' inst => Installation path of LibreOffice
- ''' prog => Program path of LibreOffice
- ''' user => The user installation/config directory
- ''' work => The work directory of the user. Under Windows this would be the "MyDocuments" subdirectory. Under Unix this would be the home-directory
- ''' home => The home directory of the user. Under Unix this would be the home- directory.
- ''' Under Windows this would be the CSIDL_PERSONAL directory, for example "Documents and Settings\<username>\Documents"
- ''' temp => The current temporary directory
- Dim oSubst As Object ' com.sun.star.util.PathSubstitution
- Dim sConfig As String ' Return value
- sConfig = ""
- Set oSubst = SF_Utils._GetUNOService("PathSubstitution")
- If Not IsNull(oSubst) Then sConfig = oSubst.getSubstituteVariableValue("$(" & psFolder & ")") & "/"
- _GetConfigFolder = SF_FileSystem._ConvertFromUrl(sConfig)
- End Function ' ScriptForge.FileSystem._GetConfigFolder
- REM -----------------------------------------------------------------------------
- Public Function _ParseUrl(psUrl As String) As Object
- ''' Returns a com.sun.star.util.URL structure based on the argument
- Dim oParse As Object ' com.sun.star.util.URLTransformer
- Dim bParsed As Boolean ' True if parsing is successful
- Dim oUrl As New com.sun.star.util.URL ' Return value
- oUrl.Complete = psUrl
- Set oParse = SF_Utils._GetUNOService("URLTransformer")
- bParsed = oParse.parseStrict(oUrl, "")
- If bParsed Then oUrl.Path = ConvertToUrl(oUrl.Path)
- Set _ParseUrl = oUrl
- End Function ' ScriptForge.SF_FileSystem._ParseUrl
- REM -----------------------------------------------------------------------------
- Public Function _SFInstallFolder() As String
- ''' Returns the installation folder of the ScriptForge library
- ''' Either:
- ''' - The library is present in [My Macros & Dialogs]
- ''' ($config)/basic/ScriptForge
- ''' - The library is present in [LibreOffice Macros & Dialogs]
- ''' ($install)/share/basic/ScriptForge
- Dim sFolder As String ' Folder
- _SFInstallFolder = ""
- sFolder = BuildPath(ConfigFolder, "basic/ScriptForge")
- If Not FolderExists(sFolder) Then
- sFolder = BuildPath(InstallFolder, "share/basic/ScriptForge")
- If Not FolderExists(sFolder) Then Exit Function
- End If
- _SFInstallFolder = _ConvertFromUrl(sFolder)
-
- End Function ' ScriptForge.SF_FileSystem._SFInstallFolder
- REM ============================================ END OF SCRIPTFORGE.SF_FileSystem
- </script:module>
|