| blob | ba1838a12f756500f62638dd923ec8b4f6203708 |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_FileSystem" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
4 REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
5 REM === Full documentation is available on https://help.libreoffice.org/ ===
6 REM =======================================================================================================================
8 Option Compatible
9 Option Explicit
11 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
12 ''' SF_FileSystem
13 ''' =============
14 ''' Class implementing the file system service
15 ''' for common file and folder handling routines
16 ''' Including copy and move of files and folders, with or without wildcards
17 ''' The design choices are largely inspired by
18 ''' https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/filesystemobject-object
19 ''' The File and Folder classes have been found redundant with the current class and have not been implemented
20 ''' The implementation is mainly based on the XSimpleFileAccess UNO interface
21 ''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1ucb_1_1XSimpleFileAccess.html
22 '''
23 ''' Subclasses:
24 ''' SF_TextStream
25 '''
26 ''' Definitions:
27 ''' File and folder names may be expressed either in the (preferable because portable) URL form
28 ''' or in the more usual operating system notation (e.g. C:\... for Windows)
29 ''' The notation, both for arguments and for returned values
30 ''' is determined by the FileNaming property: either "ANY" (default), "URL" or "SYS"
31 '''
32 ''' FileName: the full name of the file including the path without any ending path separator
33 ''' FolderName: the full name of the folder including the path and the ending path separator
34 ''' Name: the last component of the File- or FolderName including its extension
35 ''' BaseName: the last component of the File- or FolderName without its extension
36 ''' NamePattern: any of the above names containing wildcards in its last component
39 '''
41 ''' All the implemented properties and methods are applicable on usual disk file systems.
42 ''' Root is usually something like "C:\" or "/" or their URL equivalents
43 ''' Now, Libreoffice documents have an internal file system as well. Many of the proposed methods
44 ''' support document's file systems too, however, for some of them, with restrictions.
45 ''' Read the comments in the individual methods below.
46 ''' It makes browsing folders and files, adding, replacing files possible. Updates will be
47 ''' saved with the document.
49 ''' The root of a document's file system is obtained from the "FileSystem" property of a document instance, like in:
50 ''' Dim root As String, doc As Object, ui As Object
52 ''' Set doc = ui.GetDocument(ThisComponent)
53 ''' root = doc.FileSystem
54 ''' The file manifest.xml is managed automatically.
55 ''' The FileNaming setting is ignored.
56 '''
57 ''' Service invocation example:
58 ''' Dim FSO As Variant
60 '''
61 ''' Detailed user documentation:
62 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_filesystem.html?DbPAR=BASIC
63 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
65 REM ================================================================== EXCEPTIONS
68 Const UNKNOWNFOLDERERROR = "UNKNOWNFOLDERERROR" ' Source folder or Destination folder does not exist
72 Const READONLYERROR = "READONLYERROR" ' Destination has its read-only attribute set
73 Const NOFILEMATCHERROR = "NOFILEMATCHFOUND" ' No file matches Source containing wildcards
74 Const FOLDERCREATIONERROR = "FOLDERCREATIONERROR" ' FolderName is an existing folder or file
75 Const FILESYSTEMERROR = "FILESYSTEMERROR" ' The method is not applicable on document's file systems
77 REM ============================================================ MODULE CONSTANTS
79 ''' TextStream open modes
80 Const cstForReading = 1
81 Const cstForWriting = 2
82 Const cstForAppending = 8
84 ''' Document file system
87 ''' Folders and files scanning
92 REM ===================================================== CONSTRUCTOR/DESTRUCTOR
94 REM -----------------------------------------------------------------------------
95 Public Function Dispose() As Variant
96 Set Dispose = Nothing
97 End Function ' ScriptForge.SF_FileSystem Explicit destructor
99 REM ================================================================== PROPERTIES
101 REM -----------------------------------------------------------------------------
102 Property Get ConfigFolder() As String
103 ''' Return the configuration folder of LibreOffice
107 SF_Utils._EnterFunction(cstThisSub)
109 SF_Utils._ExitFunction(cstThisSub)
111 End Property ' ScriptForge.SF_FileSystem.ConfigFolder
113 REM -----------------------------------------------------------------------------
114 Property Get ExtensionsFolder() As String
115 ''' Return the folder containing the extensions installed for the current user
117 Dim oMacro As Object ' /singletons/com.sun.star.util.theMacroExpander
120 SF_Utils._EnterFunction(cstThisSub)
122 ExtensionsFolder = SF_FileSystem._ConvertFromUrl(oMacro.ExpandMacros("$UNO_USER_PACKAGES_CACHE") & "/")
123 SF_Utils._ExitFunction(cstThisSub)
125 End Property ' ScriptForge.SF_FileSystem.ExtensionsFolder
127 REM -----------------------------------------------------------------------------
128 Property Get FileNaming() As Variant
129 ''' Return the current files and folder notation, either "ANY", "URL" or "SYS"
130 ''' "ANY": methods receive either URL or native file names, but always return URL file names
131 ''' "URL": methods expect URL arguments and return URL strings (when relevant)
135 SF_Utils._EnterFunction(cstThisSub)
136 FileNaming = _SF_.FileSystemNaming
137 SF_Utils._ExitFunction(cstThisSub)
139 End Property ' ScriptForge.SF_FileSystem.FileNaming (get)
141 REM -----------------------------------------------------------------------------
142 Property Let FileNaming(ByVal pvNotation As Variant)
143 ''' Set the files and folders notation: "ANY", "URL" or "SYS"
146 SF_Utils._EnterFunction(cstThisSub)
147 If VarType(pvNotation) = V_STRING Then
148 Select Case UCase(pvNotation)
149 Case "ANY", "URL", "SYS" : _SF_.FileSystemNaming = UCase(pvNotation)
150 Case Else ' Unchanged
151 End Select
152 End If
153 SF_Utils._ExitFunction(cstThisSub)
155 End Property ' ScriptForge.SF_FileSystem.FileNaming (let)
157 REM -----------------------------------------------------------------------------
158 Property Get ForAppending As Integer
159 ''' Convenient constant (see documentation)
160 ForAppending = cstForAppending
161 End Property ' ScriptForge.SF_FileSystem.ForAppending
163 REM -----------------------------------------------------------------------------
164 Property Get ForReading As Integer
165 ''' Convenient constant (see documentation)
166 ForReading = cstForReading
167 End Property ' ScriptForge.SF_FileSystem.ForReading
169 REM -----------------------------------------------------------------------------
170 Property Get ForWriting As Integer
171 ''' Convenient constant (see documentation)
172 ForWriting = cstForWriting
173 End Property ' ScriptForge.SF_FileSystem.ForWriting
175 REM -----------------------------------------------------------------------------
176 Property Get HomeFolder() As String
177 ''' Return the user home folder
181 SF_Utils._EnterFunction(cstThisSub)
183 SF_Utils._ExitFunction(cstThisSub)
185 End Property ' ScriptForge.SF_FileSystem.HomeFolder
187 REM -----------------------------------------------------------------------------
188 Property Get InstallFolder() As String
189 ''' Return the installation folder of LibreOffice
193 SF_Utils._EnterFunction(cstThisSub)
195 SF_Utils._ExitFunction(cstThisSub)
197 End Property ' ScriptForge.SF_FileSystem.InstallFolder
199 REM -----------------------------------------------------------------------------
200 Property Get ObjectType As String
201 ''' Only to enable object representation
203 End Property ' ScriptForge.SF_FileSystem.ObjectType
205 REM -----------------------------------------------------------------------------
206 Property Get ServiceName As String
207 ''' Internal use
209 End Property ' ScriptForge.SF_FileSystem.ServiceName
211 REM -----------------------------------------------------------------------------
212 Property Get TemplatesFolder() As String
213 ''' Return the folder defined in the LibreOffice paths options as intended for templates files
215 Dim sPath As String ' Template property of com.sun.star.util.PathSettings
218 SF_Utils._EnterFunction(cstThisSub)
220 TemplatesFolder = SF_FileSystem._ConvertFromUrl(Split(sPath, ";")(0) & "/")
221 SF_Utils._ExitFunction(cstThisSub)
223 End Property ' ScriptForge.SF_FileSystem.TemplatesFolder
225 REM -----------------------------------------------------------------------------
226 Property Get TemporaryFolder() As String
227 ''' Return the folder defined in the LibreOffice paths options as intended for temporary files
231 SF_Utils._EnterFunction(cstThisSub)
233 SF_Utils._ExitFunction(cstThisSub)
235 End Property ' ScriptForge.SF_FileSystem.TemporaryFolder
237 REM -----------------------------------------------------------------------------
238 Property Get UserTemplatesFolder() As String
239 ''' Return the folder defined in the LibreOffice paths options as intended for User templates files
241 Dim sPath As String ' Template_writable property of com.sun.star.util.PathSettings
244 SF_Utils._EnterFunction(cstThisSub)
247 SF_Utils._ExitFunction(cstThisSub)
249 End Property ' ScriptForge.SF_FileSystem.UserTemplatesFolder
251 REM ===================================================================== METHODS
253 REM -----------------------------------------------------------------------------
254 Public Function BuildPath(Optional ByVal FolderName As Variant _
255 , Optional ByVal Name As Variant _
256 ) As String
257 ''' Combines a folder path and the name of a file and returns the combination with a valid path separator
258 ''' Inserts an additional path separator between the foldername and the name, only if necessary
259 ''' Args:
260 ''' FolderName: Path with which Name is combined. Path need not specify an existing folder
261 ''' Name: To be appended to the existing path.
262 ''' Returns:
263 ''' The path concatenated with the file name after insertion of a path separator, if necessary
264 ''' Example:
265 ''' Dim a As String
267 ''' a = FSO.BuildPath("C:\Windows", "Notepad.exe") returns C:\Windows\Notepad.exe
269 Dim sBuild As String ' Return value
270 Dim sFile As String ' Alias for Name
275 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
276 sBuild = ""
278 Check:
279 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
282 End If
283 FolderName = SF_FileSystem._ConvertToUrl(FolderName)
285 Try:
286 ' Add separator if necessary. FolderName is now in URL notation
288 If Right(FolderName, 1) <> "/" Then sBuild = FolderName & "/" Else sBuild = FolderName
289 Else
290 sBuild = cstFileProtocol
291 End If
292 ' Encode the file name
293 sFile = ConvertToUrl(Name)
294 ' Some file names produce http://file.name.suffix/
295 If Left(sFile, 7) = "http://" Then sFile = cstFileProtocol & Mid(sFile, 8, Len(sFile) - 8)
296 ' Combine both parts
297 If Left(sFile, Len(cstFileProtocol)) = cstFileProtocol Then sBuild = sBuild & Mid(sFile, Len(cstFileProtocol) + 1) Else sBuild = sBuild & sFile
299 Finally:
300 BuildPath = SF_FileSystem._ConvertFromUrl(sBuild)
301 SF_Utils._ExitFunction(cstThisSub)
302 Exit Function
303 Catch:
304 GoTo Finally
305 End Function ' ScriptForge.SF_FileSystem.BuildPath
307 REM -----------------------------------------------------------------------------
308 Public Function CompareFiles(Optional ByVal FileName1 As Variant _
309 , Optional ByVal FileName2 As Variant _
310 , Optional ByVal CompareContents As Variant _
311 )
313 ''' The comparison may be based on the file attributes, like modification time,
314 ''' or on their contents.
316 ''' Args:
319 ''' CompareContents: When True, the contents of the files are compared. Default = False
320 ''' Returns:
321 ''' True when the files seem identical
322 ''' Exceptions:
323 ''' UNKNOWNFILEERROR One of the files does not exist
325 ''' Example:
327 ''' MsgBox FSO.CompareFiles("C:\myFile1.txt", "C:\myFile2.txt", CompareContents := True)
329 Dim bCompare As Boolean ' Return value
337 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
338 bCompare = False
340 Check:
341 If IsMissing(CompareContents) Or IsEmpty(CompareContents) Then CompareContents = False
342 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
345 If Not SF_Utils._Validate(CompareContents, "CompareContents", V_BOOLEAN) Then GoTo Finally
346 End If
347 ' Do the files exist ? Otherwise raise error
348 sFile = FileName1 : iFile = 1
349 If Not SF_FileSystem.FileExists(sFile) Then GoTo CatchNotExists
350 sFile = FileName2 : iFile = 2
351 If Not SF_FileSystem.FileExists(sFile) Then GoTo CatchNotExists
353 sFile = FileName1 : iFile = 1
354 If SF_FileSystem._IsDocFileSystem(sFile) Then GoTo CatchNotSupported
355 sFile = FileName2 : iFile = 2
356 If SF_FileSystem._IsDocFileSystem(sFile) Then GoTo CatchNotSupported
358 Try:
359 With ScriptForge.SF_Session
360 bCompare = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _
361 , _ConvertFromUrl(FileName1) _
362 , _ConvertFromUrl(FileName2) _
363 , CompareContents)
364 End With
366 Finally:
367 CompareFiles = bCompare
368 SF_Utils._ExitFunction(cstThisSub)
369 Exit Function
370 Catch:
371 GoTo Finally
372 CatchNotExists:
374 GoTo Finally
375 CatchNotSupported:
376 SF_Exception.RaiseFatal(FILESYSTEMERROR, "FileName" & iFile, Split(cstThisSub, ".")(1), sFile)
377 GoTo Finally
378 End Function ' ScriptForge.SF_FileSystem.CompareFiles
380 REM -----------------------------------------------------------------------------
381 Public Function CopyFile(Optional ByVal Source As Variant _
382 , Optional ByVal Destination As Variant _
383 , Optional ByVal Overwrite As Variant _
384 ) As Boolean
385 ''' Copies one or more files from one location to another
386 ''' Args:
387 ''' Source: FileName or NamePattern which can include wildcard characters, for one or more files to be copied
388 ''' Destination: FileName where the single Source file is to be copied
389 ''' or FolderName where the multiple files from Source are to be copied
390 ''' If FolderName does not exist, it is created
391 ''' Anyway, wildcard characters are not allowed in Destination
392 ''' Overwrite: If True (default), files may be overwritten
393 ''' CopyFile will fail if Destination has the read-only attribute set, regardless of the value of Overwrite.
394 ''' Returns:
395 ''' True if at least one file has been copied
396 ''' False if an error occurred
397 ''' An error also occurs if a source using wildcard characters doesn't match any files.
398 ''' The method stops on the first error it encounters
399 ''' No attempt is made to roll back or undo any changes made before an error occurs
400 ''' Exceptions:
401 ''' UNKNOWNFILEERROR Source does not exist
402 ''' UNKNOWNFOLDERERROR Source folder or Destination folder does not exist
403 ''' NOFILEMATCHERROR No file matches Source containing wildcards
404 ''' NOTAFOLDERERROR Destination is a file, not a folder
405 ''' NOTAFILEERROR Destination is a folder, not a file
406 ''' OVERWRITEERROR Destination can not be overwritten
407 ''' READONLYERROR Destination has its read-only attribute set
408 ''' Example:
410 ''' FSO.CopyFile("C:\Windows\*.*", "C:\Temp\", Overwrite := False) ' Only files are copied, subfolders are not
412 Dim bCopy As Boolean ' Return value
417 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
418 bCopy = False
420 Check:
421 If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = True
422 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
426 End If
428 Try:
431 Finally:
432 CopyFile = bCopy
433 SF_Utils._ExitFunction(cstThisSub)
434 Exit Function
435 Catch:
436 GoTo Finally
437 End Function ' ScriptForge.SF_FileSystem.CopyFile
439 REM -----------------------------------------------------------------------------
440 Public Function CopyFolder(Optional ByVal Source As Variant _
441 , Optional ByVal Destination As Variant _
442 , Optional ByVal Overwrite As Variant _
443 ) As Boolean
444 ''' Copies one or more folders from one location to another
445 ''' Args:
446 ''' Source: FolderName or NamePattern which can include wildcard characters, for one or more folders to be copied
447 ''' Destination: FolderName where the single Source folder is to be copied
448 ''' or FolderName where the multiple folders from Source are to be copied
449 ''' If FolderName does not exist, it is created
450 ''' Anyway, wildcard characters are not allowed in Destination
451 ''' Overwrite: If True (default), folders and their content may be overwritten
452 ''' CopyFile will fail if Destination has the read-only attribute set, regardless of the value of Overwrite.
453 ''' Returns:
454 ''' True if at least one folder has been copied
455 ''' False if an error occurred
456 ''' An error also occurs if a source using wildcard characters doesn't match any folders.
457 ''' The method stops on the first error it encounters
458 ''' No attempt is made to roll back or undo any changes made before an error occurs
459 ''' Exceptions:
460 ''' UNKNOWNFILEERROR Source does not exist
461 ''' UNKNOWNFOLDERERROR Source folder or Destination folder does not exist
462 ''' NOFILEMATCHERROR No file matches Source containing wildcards
463 ''' NOTAFOLDERERROR Destination is a file, not a folder
464 ''' OVERWRITEERROR Destination can not be overwritten
465 ''' READONLYERROR Destination has its read-only attribute set
466 ''' Example:
468 ''' FSO.CopyFolder("C:\Windows\*", "C:\Temp\", Overwrite := False)
470 Dim bCopy As Boolean ' Return value
475 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
476 bCopy = False
478 Check:
479 If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = True
480 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
484 End If
486 Try:
489 Finally:
490 CopyFolder = bCopy
491 SF_Utils._ExitFunction(cstThisSub)
492 Exit Function
493 Catch:
494 GoTo Finally
495 End Function ' ScriptForge.SF_FileSystem.CopyFolder
497 REM -----------------------------------------------------------------------------
498 Public Function CreateFolder(Optional ByVal FolderName As Variant) As Boolean
499 ''' Return True if the given folder name could be created successfully
500 ''' The parent folder does not need to exist beforehand
501 ''' Args:
502 ''' FolderName: a string representing the folder to create. It must not exist
503 ''' Returns:
504 ''' True if FolderName is a valid folder name, does not exist and creation was successful
505 ''' False otherwise including when FolderName is a file
506 ''' Exceptions:
507 ''' FOLDERCREATIONERROR FolderName is an existing folder or file
508 ''' Example:
512 Dim bCreate As Boolean ' Return value
513 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
518 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
519 bCreate = False
521 Check:
522 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
524 End If
526 Try:
528 If SF_FileSystem.FolderExists(FolderName) Then GoTo CatchExists
529 If SF_FileSystem.FileExists(FolderName) Then GoTo CatchExists
530 oSfa.createFolder(SF_FileSystem._ConvertToUrl(FolderName))
531 bCreate = True
533 Finally:
534 CreateFolder = bCreate
535 SF_Utils._ExitFunction(cstThisSub)
536 Exit Function
537 Catch:
538 GoTo Finally
539 CatchExists:
541 GoTo Finally
542 End Function ' ScriptForge.SF_FileSystem.CreateFolder
544 REM -----------------------------------------------------------------------------
545 Public Function CreateTextFile(Optional ByVal FileName As Variant _
546 , Optional ByVal Overwrite As Variant _
547 , Optional ByVal Encoding As Variant _
548 ) As Object
549 ''' Creates a specified file and returns a TextStream object that can be used to write to the file
550 ''' Args:
551 ''' FileName: Identifies the file to create
552 ''' Overwrite: Boolean value that indicates if an existing file can be overwritten (default = True)
553 ''' Encoding: The character set that should be used
554 ''' Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml
555 ''' Note that LibreOffice does not implement all existing sets
557 ''' Returns:
558 ''' An instance of the SF_TextStream class representing the opened file or a Null object if an error occurred
559 ''' It doesn't check either if the given encoding is implemented in LibreOffice
560 ''' Exceptions:
561 ''' OVERWRITEERROR File exists, creation impossible
562 ''' Example:
563 ''' Dim myFile As Object
565 ''' Set myFile = FSO.CreateTextFile("C:\Temp\ThisFile.txt", Overwrite := True)
567 Dim oTextStream As Object ' Return value
569 Const cstSubArgs = "FileName, [Overwrite=True], [Encoding=""UTF-8""]"
571 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
572 Set oTextStream = Nothing
574 Check:
575 If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = True
577 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
581 End If
583 With SF_FileSystem
584 If .FileExists(FileName) Then
585 If Overwrite Then .DeleteFile(FileName) Else GoTo CatchOverWrite
586 End If
588 Try:
589 Set oTextStream = .OpenTextFile(FileName, .ForWriting, Create := True, Encoding := Encoding)
590 End With
592 Finally:
593 Set CreateTextFile = oTextStream
594 SF_Utils._ExitFunction(cstThisSub)
595 Exit Function
596 Catch:
597 GoTo Finally
598 CatchOverWrite:
600 GoTo Finally
601 End Function ' ScriptForge.SF_FileSystem.CreateTextFile
603 REM -----------------------------------------------------------------------------
604 Public Function DeleteFile(Optional ByVal FileName As Variant) As Boolean
605 ''' Deletes one or more files
606 ''' Args:
607 ''' FileName: FileName or NamePattern which can include wildcard characters, for one or more files to be deleted
608 ''' Returns:
609 ''' True if at least one file has been deleted
610 ''' False if an error occurred
611 ''' An error also occurs if a FileName using wildcard characters doesn't match any files.
612 ''' The method stops on the first error it encounters
613 ''' No attempt is made to roll back or undo any changes made before an error occurs
614 ''' Exceptions:
615 ''' UNKNOWNFILEERROR FileName does not exist
616 ''' NOFILEMATCHERROR No file matches FileName containing wildcards
617 ''' NOTAFILEERROR Argument is a folder, not a file
618 ''' Example:
620 ''' FSO.DeleteFile("C:\Temp\*.*") ' Only files are deleted, subfolders are not
622 Dim bDelete As Boolean ' Return value
627 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
628 bDelete = False
630 Check:
631 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
633 End If
635 Try:
638 Finally:
639 DeleteFile = bDelete
640 SF_Utils._ExitFunction(cstThisSub)
641 Exit Function
642 Catch:
643 GoTo Finally
644 End Function ' ScriptForge.SF_FileSystem.DeleteFile
646 REM -----------------------------------------------------------------------------
647 Public Function DeleteFolder(Optional ByVal FolderName As Variant) As Boolean
648 ''' Deletes one or more Folders
649 ''' Args:
650 ''' FolderName: FolderName or NamePattern which can include wildcard characters, for one or more Folders to be deleted
651 ''' Returns:
652 ''' True if at least one folder has been deleted
653 ''' False if an error occurred
654 ''' An error also occurs if a FolderName using wildcard characters doesn't match any folders.
655 ''' The method stops on the first error it encounters
656 ''' No attempt is made to roll back or undo any changes made before an error occurs
657 ''' Exceptions:
658 ''' UNKNOWNFOLDERERROR FolderName does not exist
659 ''' NOFILEMATCHERROR No folder matches FolderName containing wildcards
660 ''' NOTAFOLDERERROR Argument is a file, not a folder
661 ''' Example:
663 ''' FSO.DeleteFolder("C:\Temp\*") ' Only folders are deleted, files in the parent folder are not
665 Dim bDelete As Boolean ' Return value
670 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
671 bDelete = False
673 Check:
674 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
676 End If
678 Try:
681 Finally:
682 DeleteFolder = bDelete
683 SF_Utils._ExitFunction(cstThisSub)
684 Exit Function
685 Catch:
686 GoTo Finally
687 End Function ' ScriptForge.SF_FileSystem.DeleteFolder
689 REM -----------------------------------------------------------------------------
690 Public Function ExtensionFolder(Optional ByVal Extension As Variant) As String
691 ''' Return the folder where the given extension is installed. The argument must
692 ''' be in the list of extensions provided by the SF_Platform.Extensions property
693 ''' Args:
694 ''' Extension: a valid extension name
695 ''' Returns:
696 ''' The requested folder using the FileNaming notation
697 ''' Example:
700 Dim sFolder As String ' Return value
701 Static vExtensions As Variant ' Cached list of existing extension names
702 Dim oPackage As Object ' /singletons/com.sun.star.deployment.PackageInformationProvider
706 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
707 sFolder = ""
709 Check:
710 If IsEmpty(vExtensions) Then vExtensions = SF_Platform.Extensions
711 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
712 If Not SF_Utils._Validate(Extension, "Extension", V_STRING, vExtensions, True) Then GoTo Finally
713 End If
715 Try:
716 ' Search an individual folder
718 sFolder = oPackage.getPackageLocation(Extension)
720 Finally:
721 ExtensionFolder = SF_FileSystem._ConvertFromUrl(sFolder)
722 SF_Utils._ExitFunction(cstThisSub)
723 Exit Function
724 Catch:
725 GoTo Finally
726 End Function ' ScriptForge.SF_FileSystem.ExtensionFolder
728 REM -----------------------------------------------------------------------------
729 Public Function FileExists(Optional ByVal FileName As Variant) As Boolean
730 ''' Return True if the given file exists
731 ''' Args:
732 ''' FileName: a string representing a file
733 ''' Returns:
734 ''' True if FileName is a valid File name and it exists
735 ''' False otherwise including when FileName is a folder
736 ''' Example:
740 Dim bExists As Boolean ' Return value
741 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
746 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
747 bExists = False
749 Check:
750 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
752 End If
753 FileName = SF_FileSystem._ConvertToUrl(FileName)
755 Try:
757 bExists = oSfa.exists(FileName) And Not oSfa.isFolder(FileName)
759 Finally:
760 FileExists = bExists
761 SF_Utils._ExitFunction(cstThisSub)
762 Exit Function
763 Catch:
764 GoTo Finally
765 End Function ' ScriptForge.SF_FileSystem.FileExists
767 REM -----------------------------------------------------------------------------
768 Public Function Files(Optional ByVal FolderName As Variant _
769 , Optional ByVal Filter As Variant _
770 , Optional ByVal IncludeSubfolders As Variant _
771 ) As Variant
772 ''' Return an array of the FileNames stored in the given folder. The folder must exist
773 ''' Subfolders may be optionally explored too.
774 ''' If the number of files exceeds a reasonable amount (> 1000 ?), the process time may become long.
775 ''' Args:
776 ''' FolderName: the folder to explore
777 ''' Filter: contains wildcards ("?" and "*") to limit the list to the relevant files (default = "")
778 ''' IncludeSubfolders: when True (default = False), subfolders are explored too.
779 ''' Returns:
780 ''' An array of strings, each entry is the FileName of an existing file
781 ''' Exceptions:
782 ''' UNKNOWNFOLDERERROR Folder does not exist
783 ''' NOTAFOLDERERROR FolderName is a file, not a folder
784 ''' Example:
785 ''' Dim a As Variant
789 Dim vFiles As Variant ' Return value
790 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
791 Dim sFilesColl As String ' cstSEPARATOR delimited string of list of files (FileNaming notation)
792 Dim i As Long
795 Const cstSubArgs = "FolderName, [Filter=""""], [IncludeSubfolders=False]"
797 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
798 vFiles = Array()
800 Check:
801 If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = ""
802 If IsMissing(IncludeSubfolders) Or IsEmpty(IncludeSubfolders) Then IncludeSubfolders = False
803 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
806 If Not SF_Utils._Validate(IncludeSubfolders, "IncludeSubfolders", V_BOOLEAN) Then GoTo Finally
807 End If
808 If SF_FileSystem.FileExists(FolderName) Then GoTo CatchFile ' Must not be a file
809 If Not SF_FileSystem.FolderExists(FolderName) Then GoTo CatchFolder ' Folder must exist
811 Try:
812 sFilesColl = ""
814 SF_FileSystem._ScanFolder(cstFiles, sFilesColl, FolderName, oSfa, Filter, IncludeSubfolders)
816 If Len(sFilesColl) > Len(cstSEPARATOR) Then vFiles() = Split(Mid(sFilesColl, Len(cstSEPARATOR) + 1), cstSEPARATOR)
818 Finally:
819 Files = vFiles
820 SF_Utils._ExitFunction(cstThisSub)
821 Exit Function
822 Catch:
823 GoTo Finally
824 CatchFile:
826 GoTo Finally
827 CatchFolder:
829 GoTo Finally
830 End Function ' ScriptForge.SF_FileSystem.Files
832 REM -----------------------------------------------------------------------------
833 Public Function FolderExists(Optional ByVal FolderName As Variant) As Boolean
834 ''' Return True if the given folder name exists
835 ''' Args:
836 ''' FolderName: a string representing a folder
837 ''' Returns:
838 ''' True if FolderName is a valid folder name and it exists
839 ''' False otherwise including when FolderName is a file
840 ''' Example:
844 Dim bExists As Boolean ' Return value
845 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
850 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
851 bExists = False
853 Check:
854 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
856 End If
857 FolderName = SF_FileSystem._ConvertToUrl(FolderName)
859 Try:
861 bExists = oSfa.isFolder(FolderName)
863 Finally:
864 FolderExists = bExists
865 SF_Utils._ExitFunction(cstThisSub)
866 Exit Function
867 Catch:
868 GoTo Finally
869 End Function ' ScriptForge.SF_FileSystem.FolderExists
871 REM -----------------------------------------------------------------------------
872 Public Function GetBaseName(Optional ByVal FileName As Variant) As String
873 ''' Returns the BaseName part of the last component of a File- or FolderName, without its extension
874 ''' The method does not check for the existence of the specified file or folder
875 ''' Args:
876 ''' FileName: Path and file name
877 ''' Returns:
878 ''' The BaseName of the given argument in native operating system format. May be empty
879 ''' Example:
880 ''' Dim a As String
884 Dim sBase As String ' Return value
885 Dim sExt As String ' Extension
886 Dim sName As String ' Last component of FileName
887 Dim vName As Variant ' Array of trunks of sName
891 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
892 sBase = ""
894 Check:
895 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
897 End If
899 Try:
900 sName = SF_FileSystem.GetName(FileName)
904 sExt = vName(UBound(vName))
905 sBase = Left(sName, Len(sName) - Len(sExt) - 1)
906 Else
907 sBase = sName
908 End If
909 End If
911 Finally:
912 GetBaseName = sBase
913 SF_Utils._ExitFunction(cstThisSub)
914 Exit Function
915 Catch:
916 GoTo Finally
917 End Function ' ScriptForge.SF_FileSystem.GetBaseName
919 REM -----------------------------------------------------------------------------
920 Public Function GetExtension(Optional ByVal FileName As Variant) As String
921 ''' Returns the extension part of a File- or FolderName, without the dot (.).
922 ''' The method does not check for the existence of the specified file or folder
923 ''' Args:
924 ''' FileName: Path and file name
925 ''' Returns:
926 ''' The extension without a leading dot. May be empty
927 ''' Example:
928 ''' Dim a As String
932 Dim sExt As String ' Return value
933 Dim sName As String ' Last component of FileName
934 Dim vName As Variant ' Array of trunks of sName
938 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
939 sExt = ""
941 Check:
942 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
944 End If
946 Try:
947 sName = SF_FileSystem.GetName(FileName)
950 sExt = vName(UBound(vName))
951 End If
953 Finally:
954 GetExtension = sExt
955 SF_Utils._ExitFunction(cstThisSub)
956 Exit Function
957 Catch:
958 GoTo Finally
959 End Function ' ScriptForge.SF_FileSystem.GetExtension
961 REM -----------------------------------------------------------------------------
962 Public Function GetFileLen(Optional ByVal FileName As Variant) As Currency
964 ''' Args:
965 ''' FileName: a string representing a file
966 ''' Returns:
967 ''' File size if FileName exists
969 ''' Exceptions:
970 ''' UNKNOWNFILEERROR The file does not exist or is a folder
971 ''' Example:
974 Dim curSize As Currency ' Return value
979 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
980 curSize = 0
982 Check:
983 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
985 End If
987 Try:
988 If SF_FileSystem.FileExists(FileName) Then
989 If SF_FileSystem._IsDocFileSystem(FileName) Then
990 curSize = 0
991 Else
992 With ScriptForge.SF_Session
993 curSize = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _
994 , _ConvertFromUrl(FileName))
995 End With
996 End If
997 Else
998 GoTo CatchNotExists
999 End If
1001 Finally:
1002 GetFileLen = curSize
1003 SF_Utils._ExitFunction(cstThisSub)
1004 Exit Function
1005 Catch:
1006 GoTo Finally
1007 CatchNotExists:
1009 GoTo Finally
1010 End Function ' ScriptForge.SF_FileSystem.GetFileLen
1012 REM -----------------------------------------------------------------------------
1013 Public Function GetFileModified(Optional ByVal FileName As Variant) As Variant
1014 ''' Returns the last modified date for the given file
1016 ''' Args:
1017 ''' FileName: a string representing an existing file
1018 ''' Returns:
1019 ''' The modification date and time as a Basic Date
1020 ''' Exceptions:
1021 ''' UNKNOWNFILEERROR The file does not exist or is a folder
1022 ''' FILESYSTEMERROR The method is not applicable on document's file systems
1023 ''' Example:
1024 ''' Dim a As Date
1028 Dim dModified As Date ' Return value
1029 Dim oModified As New com.sun.star.util.DateTime
1030 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
1035 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1036 dModified = 0
1038 Check:
1039 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1041 End If
1042 If SF_FileSystem._IsDocFileSystem(FileName) Then GoTo CatchNotSupported
1044 Try:
1046 If SF_FileSystem.FileExists(FileName) Then
1047 FileName = SF_FileSystem._ConvertToUrl(FileName)
1048 Set oModified = oSfa.getDateTimeModified(FileName)
1049 dModified = CDateFromUnoDateTime(oModified)
1050 Else
1051 GoTo CatchNotExists
1052 End If
1054 Finally:
1055 GetFileModified = dModified
1056 SF_Utils._ExitFunction(cstThisSub)
1057 Exit Function
1058 Catch:
1059 GoTo Finally
1060 CatchNotExists:
1062 GoTo Finally
1063 CatchNotSupported:
1064 SF_Exception.RaiseFatal(FILESYSTEMERROR, "FileName", Split(cstThisSub, ".")(1), FileName)
1065 GoTo Finally
1066 End Function ' ScriptForge.SF_FileSystem.GetFileModified
1068 REM -----------------------------------------------------------------------------
1069 Public Function GetName(Optional ByVal FileName As Variant) As String
1070 ''' Returns the last component of a File- or FolderName
1071 ''' The method does not check for the existence of the specified file or folder
1072 ''' Args:
1073 ''' FileName: Path and file name
1074 ''' Returns:
1075 ''' The last component of the full file name in native operating system format
1076 ''' Example:
1077 ''' Dim a As String
1081 Dim sName As String ' Return value
1082 Dim vFile As Variant ' Array of components
1086 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1087 sName = ""
1089 Check:
1090 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1092 End If
1093 FileName = SF_FileSystem._ConvertToUrl(FileName)
1095 Try:
1099 sName = ConvertFromUrl(vFile(UBound(vFile))) ' Always in SYS format
1100 End If
1102 Finally:
1103 GetName = sName
1104 SF_Utils._ExitFunction(cstThisSub)
1105 Exit Function
1106 Catch:
1107 GoTo Finally
1108 End Function ' ScriptForge.SF_FileSystem.GetName
1110 REM -----------------------------------------------------------------------------
1111 Public Function GetParentFolderName(Optional ByVal FileName As Variant) As String
1112 ''' Returns a string containing the name of the parent folder of the last component in a specified File- or FolderName
1113 ''' The method does not check for the existence of the specified file or folder
1114 ''' Args:
1115 ''' FileName: Path and file name
1116 ''' Returns:
1117 ''' A FolderName including its final path separator
1118 ''' Example:
1119 ''' Dim a As String
1121 ''' a = FSO.GetParentFolderName("C:\Windows\Notepad.exe") returns C:\Windows\
1123 Dim sFolder As String ' Return value
1124 Dim sName As String ' Last component of FileName
1125 Dim vFile As Variant ' Array of file components
1129 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1130 sFolder = ""
1132 Check:
1133 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1135 End If
1136 FileName = SF_FileSystem._ConvertToUrl(FileName)
1138 Try:
1143 If sFolder = "" Or Right(sFolder, 1) <> "/" Then sFolder = sFolder & "/"
1145 Finally:
1146 GetParentFolderName = SF_FileSystem._ConvertFromUrl(sFolder)
1147 SF_Utils._ExitFunction(cstThisSub)
1148 Exit Function
1149 Catch:
1150 GoTo Finally
1151 End Function ' ScriptForge.SF_FileSystem.GetParentFolderName
1153 REM -----------------------------------------------------------------------------
1154 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
1155 ''' Return the actual value of the given property
1156 ''' Args:
1157 ''' PropertyName: the name of the property as a string
1158 ''' Returns:
1159 ''' The actual value of the property
1160 ''' Exceptions
1161 ''' ARGUMENTERROR The property does not exist
1166 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1167 GetProperty = Null
1169 Check:
1170 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1171 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
1172 End If
1174 Try:
1175 Select Case UCase(PropertyName)
1184 Case Else
1185 End Select
1187 Finally:
1188 SF_Utils._ExitFunction(cstThisSub)
1189 Exit Function
1190 Catch:
1191 GoTo Finally
1192 End Function ' ScriptForge.SF_FileSystem.GetProperty
1194 REM -----------------------------------------------------------------------------
1195 Public Function GetTempName(Optional ByVal Extension As Variant) As String
1196 ''' Returns a randomly generated temporary file name that is useful for performing
1197 ''' operations that require a temporary file : the method does not create any file
1198 ''' Args:
1199 ''' Returns:
1200 ''' A FileName as a String that can be used f.i. with CreateTextFile()
1201 ''' The FileName has as suffix the given extension.
1202 ''' Example:
1203 ''' Dim a As String
1208 Dim sFile As String ' Return value
1209 Dim sExtension As String ' The given extension preceded by a dot
1210 Dim lRandom As Long ' Random integer
1213 Const cstSubArgs = ""
1215 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1216 sFile = ""
1218 Check:
1219 If IsMissing(Extension) Or IsEmpty(Extension) Then Extension = ""
1220 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1222 End If
1224 Try:
1226 If Len(Extension) > 0 Then sExtension = "." & Extension Else sExtension = ""
1227 sFile = SF_FileSystem.TemporaryFolder & "SF_" & Right("000000" & lRandom, 6) & sExtension
1229 Finally:
1230 GetTempName = SF_FileSystem._ConvertFromUrl(sFile)
1231 SF_Utils._ExitFunction(cstThisSub)
1232 Exit Function
1233 Catch:
1234 GoTo Finally
1235 End Function ' ScriptForge.SF_FileSystem.GetTempName
1237 REM -----------------------------------------------------------------------------
1238 Public Function HashFile(Optional ByVal FileName As Variant _
1239 , Optional ByVal Algorithm As Variant _
1240 ) As String
1241 ''' Return an hexadecimal string representing a checksum of the given file
1242 ''' Next algorithms are supported: MD5, SHA1, SHA224, SHA256, SHA384 and SHA512
1244 ''' Args:
1245 ''' FileName: a string representing a file
1246 ''' Algorithm: The hashing algorithm to use
1247 ''' Returns:
1248 ''' The requested checksum as a string. Hexadecimal digits are lower-cased
1249 ''' A zero-length string when an error occurred
1250 ''' Exceptions:
1251 ''' UNKNOWNFILEERROR The file does not exist or is a folder
1252 ''' FILESYSTEMERROR The method is not applicable on document's file systems
1253 ''' Example:
1256 Dim sHash As String ' Return value
1259 Const cstSubArgs = "FileName, Algorithm=""MD5""|""SHA1""|""SHA224""|""SHA256""|""SHA384""|""SHA512"""
1261 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1262 sHash = ""
1264 Check:
1265 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1268 , Array("MD5", "SHA1", "SHA224", "SHA256", "SHA384", "SHA512")) Then GoTo Finally
1269 End If
1270 If SF_FileSystem._IsDocFileSystem(FileName) Then GoTo CatchNotSupported
1272 Try:
1273 If SF_FileSystem.FileExists(FileName) Then
1274 With ScriptForge.SF_Session
1275 sHash = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _
1276 , _ConvertFromUrl(FileName), LCase(Algorithm))
1277 End With
1278 Else
1279 GoTo CatchNotExists
1280 End If
1282 Finally:
1283 HashFile = sHash
1284 SF_Utils._ExitFunction(cstThisSub)
1285 Exit Function
1286 Catch:
1287 GoTo Finally
1288 CatchNotExists:
1290 GoTo Finally
1291 CatchNotSupported:
1292 SF_Exception.RaiseFatal(FILESYSTEMERROR, "FileName", Split(cstThisSub, ".")(1), FileName)
1293 GoTo Finally
1294 End Function ' ScriptForge.SF_FileSystem.HashFile
1296 REM -----------------------------------------------------------------------------
1297 Public Function Methods() As Variant
1298 ''' Return the list or methods of the FileSystem service as an array
1327 )
1329 End Function ' ScriptForge.SF_FileSystem.Methods
1331 REM -----------------------------------------------------------------------------
1332 Public Function MoveFile(Optional ByVal Source As Variant _
1333 , Optional ByVal Destination As Variant _
1334 ) As Boolean
1335 ''' Moves one or more files from one location to another
1336 ''' Args:
1337 ''' Source: FileName or NamePattern which can include wildcard characters, for one or more files to be moved
1338 ''' Destination: FileName where the single Source file is to be moved
1339 ''' If Source and Destination have the same parent folder MoveFile amounts to renaming the Source
1340 ''' or FolderName where the multiple files from Source are to be moved
1341 ''' If FolderName does not exist, it is created
1342 ''' Anyway, wildcard characters are not allowed in Destination
1343 ''' Returns:
1344 ''' True if at least one file has been moved
1345 ''' False if an error occurred
1346 ''' An error also occurs if a source using wildcard characters doesn't match any files.
1347 ''' The method stops on the first error it encounters
1348 ''' No attempt is made to roll back or undo any changes made before an error occurs
1349 ''' Exceptions:
1350 ''' UNKNOWNFILEERROR Source does not exist
1351 ''' UNKNOWNFOLDERERROR Source folder or Destination folder does not exist
1352 ''' NOFILEMATCHERROR No file matches Source containing wildcards
1353 ''' NOTAFOLDERERROR Destination is a file, not a folder
1354 ''' NOTAFILEERROR Destination is a folder, not a file
1355 ''' OVERWRITEERROR Destination can not be overwritten
1356 ''' Example:
1358 ''' FSO.MoveFile("C:\Temp1\*.*", "C:\Temp2\") ' Only files are moved, subfolders are not
1360 Dim bMove As Boolean ' Return value
1365 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1366 bMove = False
1368 Check:
1369 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1372 End If
1374 Try:
1377 Finally:
1378 MoveFile = bMove
1379 SF_Utils._ExitFunction(cstThisSub)
1380 Exit Function
1381 Catch:
1382 GoTo Finally
1383 End Function ' ScriptForge.SF_FileSystem.MoveFile
1385 REM -----------------------------------------------------------------------------
1386 Public Function MoveFolder(Optional ByVal Source As Variant _
1387 , Optional ByVal Destination As Variant _
1388 ) As Boolean
1389 ''' Moves one or more folders from one location to another
1390 ''' Args:
1391 ''' Source: FolderName or NamePattern which can include wildcard characters, for one or more folders to be moved
1392 ''' Destination: FolderName where the single Source folder is to be moved
1393 ''' FolderName must not exist
1394 ''' or FolderName where the multiple folders from Source are to be moved
1395 ''' If FolderName does not exist, it is created
1396 ''' Anyway, wildcard characters are not allowed in Destination
1397 ''' Returns:
1398 ''' True if at least one folder has been moved
1399 ''' False if an error occurred
1400 ''' An error also occurs if a source using wildcard characters doesn't match any folders.
1401 ''' The method stops on the first error it encounters
1402 ''' No attempt is made to roll back or undo any changes made before an error occurs
1403 ''' Exceptions:
1404 ''' UNKNOWNFILEERROR Source does not exist
1405 ''' UNKNOWNFOLDERERROR Source folder or Destination folder does not exist
1406 ''' NOFILEMATCHERROR No file matches Source containing wildcards
1407 ''' NOTAFOLDERERROR Destination is a file, not a folder
1408 ''' OVERWRITEERROR Destination can not be overwritten
1409 ''' Example:
1413 Dim bMove As Boolean ' Return value
1418 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1419 bMove = False
1421 Check:
1422 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1425 End If
1427 Try:
1430 Finally:
1431 MoveFolder = bMove
1432 SF_Utils._ExitFunction(cstThisSub)
1433 Exit Function
1434 Catch:
1435 GoTo Finally
1436 End Function ' ScriptForge.SF_FileSystem.MoveFolder
1438 REM -----------------------------------------------------------------------------
1439 Public Function Normalize(Optional ByVal FileName As Variant) As String
1440 ''' Normalize a pathname by collapsing redundant separators and up-level references
1441 ''' so that A//B, A/B/, A/./B and A/foo/../B all become A/B.
1442 ''' On Windows, it converts forward slashes to backward slashes.
1443 ''' The method returns the input string when the file is from a document's internal file systems.
1444 ''' Args:
1445 ''' FileName: a string representing a file. The file may not exist.
1446 ''' Returns:
1447 ''' The normalized filename in filenaming notation
1448 ''' Example:
1449 ''' Print SF_FileSystem.Normalize("A/foo/../B/C/./D//E") ' A/B/C/D/E
1451 Dim sNorm As String ' Return value
1456 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1457 sNorm = ""
1459 Check:
1460 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1462 End If
1464 Try:
1465 If SF_FileSystem._IsDocFileSystem(FileName) Then
1466 sNorm = FileName
1467 Else
1468 With ScriptForge.SF_Session
1469 sNorm = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _
1470 , _ConvertFromUrl(FileName))
1471 ' The Python os.path expects and returns a file name in os notation
1473 End With
1474 End If
1476 Finally:
1477 Normalize = sNorm
1478 SF_Utils._ExitFunction(cstThisSub)
1479 Exit Function
1480 Catch:
1481 GoTo Finally
1482 End Function ' ScriptForge.SF_FileSystem.Normalize
1484 REM -----------------------------------------------------------------------------
1485 Public Function OpenTextFile(Optional ByVal FileName As Variant _
1486 , Optional ByVal IOMode As Variant _
1487 , Optional ByVal Create As Variant _
1488 , Optional ByVal Encoding As Variant _
1489 ) As Object
1490 ''' Opens a specified file and returns a TextStream object that can be used to read from, write to, or append to the file
1491 ''' Args:
1492 ''' FileName: Identifies the file to open
1493 ''' IOMode: Indicates input/output mode. Can be one of three constants: ForReading, ForWriting, or ForAppending
1494 ''' Create: Boolean value that indicates whether a new file can be created if the specified filename doesn't exist.
1495 ''' The value is True if a new file and its parent folders may be created; False if they aren't created (default)
1496 ''' Encoding: The character set that should be used
1497 ''' Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml
1498 ''' Note that LibreOffice does not implement all existing sets
1500 ''' Returns:
1501 ''' An instance of the SF_TextStream class representing the opened file or a Null object if an error occurred
1502 ''' The method does not check if the file is really a text file
1503 ''' It doesn't check either if the given encoding is implemented in LibreOffice nor if it is the right one
1504 ''' Exceptions:
1505 ''' UNKNOWNFILEERROR File does not exist
1506 ''' Example:
1507 ''' Dim myFile As Object
1509 ''' Set myFile = FSO.OpenTextFile("C:\Temp\ThisFile.txt", FSO.ForReading)
1512 Dim oTextStream As Object ' Return value
1513 Dim bExists As Boolean ' When True, file to open does exist
1514 Dim bEmbeddedFile As Boolean ' When True, file to open is embedded in a document's internal file system
1515 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
1517 Const cstSubArgs = "FileName, [IOMode=1|2|8], [Create=False], [Encoding=""UTF-8""]"
1519 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1520 Set oTextStream = Nothing
1522 Check:
1523 With SF_FileSystem
1524 If IsMissing(IOMode) Or IsEmpty(IOMode) Then IOMode = cstForReading
1525 If IsMissing(Create) Or IsEmpty(Create) Then Create = False
1527 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1530 , Array(cstForReading, cstForWriting, cstForAppending)) _
1531 Then GoTo Finally
1534 End If
1536 bExists = .FileExists(FileName)
1537 Select Case IOMode
1538 Case ForReading : If Not bExists Then GoTo CatchNotExists
1539 Case Else : If Not bExists And Not Create Then GoTo CatchNotExists
1540 End Select
1542 If IOMode = ForAppending And Not bExists Then IOMode = ForWriting
1544 bEmbeddedFile = SF_FileSystem._IsDocFileSystem(FileName)
1545 End With
1547 Try:
1548 ' Create and initialize TextStream class instance
1549 Set oTextStream = New SF_TextStream
1550 With oTextStream
1551 .[Me] = oTextStream
1552 .[_Parent] = SF_FileSystem
1553 ._IsEmbeddedFile = bEmbeddedFile
1554 If bEmbeddedFile And (IOMode = cstForWriting Or IOMode = cstForAppending) Then
1555 ' Updates of an embedded file are done on a copy
1556 ._EmbeddedFileName = SF_FileSystem._ConvertToUrl(FileName)
1557 ._FileName = SF_FileSystem._ConvertToUrl(SF_FileSystem.GetTempName(SF_FileSystem.GetExtension(FileName)))
1558 ' Create the copy if relevant
1559 If bExists Then
1561 oSfa.copy(._EmbeddedFileName, ._FileName)
1562 End If
1563 Else
1564 ._FileName = SF_FileSystem._ConvertToUrl(FileName)
1565 End If
1566 ._IOMode = IOMode
1567 ._Encoding = Encoding
1568 ._FileExists = bExists
1569 ._Initialize()
1570 End With
1572 Finally:
1573 Set OpenTextFile = oTextStream
1574 SF_Utils._ExitFunction(cstThisSub)
1575 Exit Function
1576 Catch:
1577 GoTo Finally
1578 CatchNotExists:
1580 GoTo Finally
1581 End Function ' ScriptForge.SF_FileSystem.OpenTextFile
1583 REM -----------------------------------------------------------------------------
1584 Public Function PickFile(Optional ByVal DefaultFile As Variant _
1585 , Optional ByVal Mode As Variant _
1586 , Optional ByVal Filter As Variant _
1587 ) As String
1588 ''' Returns the file selected with a FilePicker dialog box
1589 ''' The mode, OPEN or SAVE, and the filter may be preset
1590 ''' If mode = SAVE and the picked file exists, a warning message will be displayed
1593 ''' Args:
1594 ''' DefaultFile: Folder part: the FolderName from which to start. Default = the last selected folder
1595 ''' File part: the default file to open or save
1597 ''' Filter: by default only files having the given suffix will be displayed. Default = all suffixes
1598 ''' The filter combo box will contain the given suffix filter (if not "*") and "*.*"
1599 ''' Returns:
1600 ''' The selected FileName in FileNaming format or "" if the dialog was cancelled
1601 ''' Exceptions:
1602 ''' FILESYSTEMERROR The method is not applicable on document's file systems
1603 ''' Example:
1605 ''' FSO.PickFile("C:\", "OPEN", "txt") ' Only *.txt files are displayed
1607 Dim oFileDialog As Object ' com.sun.star.ui.dialogs.FilePicker
1608 Dim oFileAccess As object ' com.sun.star.ucb.SimpleFileAccess
1609 Dim oPath As Object ' com.sun.star.util.PathSettings
1610 Dim iAccept As Integer ' Result of dialog execution
1611 Dim sInitPath As String ' Current working directory
1612 Dim sBaseFile As String
1613 Dim iMode As Integer ' Numeric alias for SelectMode
1614 Dim sFile As String ' Return value
1617 Const cstSubArgs = "[DefaultFile=""""], [Mode=""OPEN""|""SAVE""],[Filter=""""]"
1619 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1620 sFile = ""
1622 Check:
1623 If IsMissing(DefaultFile) Or IsEmpty(DefaultFile) Then DefaultFile = ""
1625 If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = ""
1626 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1628 If Not SF_Utils._Validate(Mode, "Mode", V_STRING, Array("OPEN", "SAVE")) Then GoTo Finally
1630 End If
1631 If SF_FileSystem._IsDocFileSystem(DefaultFile) Then GoTo CatchNotSupported
1632 DefaultFile = SF_FileSystem._ConvertToUrl(DefaultFile)
1634 Try:
1635 ' Derive numeric equivalent of the Mode argument: https://api.libreoffice.org/docs/idl/ref/TemplateDescription_8idl.html
1636 With com.sun.star.ui.dialogs.TemplateDescription
1637 If UCase(Mode) = "OPEN" Then iMode = .FILEOPEN_SIMPLE Else iMode = .FILESAVE_AUTOEXTENSION
1638 End With
1640 ' Activate the filepicker dialog
1642 With oFileDialog
1643 .Initialize(Array(iMode))
1645 ' Set filters
1646 If Len(Filter) > 0 Then .appendFilter("*." & Filter, "*." & Filter) ' Twice: required by API
1648 If Len(Filter) > 0 Then .setCurrentFilter("*." & Filter) Else .setCurrentFilter("*.*")
1650 ' Set initial folder
1653 sInitPath = oPath.Work ' Probably My Documents
1654 Else
1655 sInitPath = SF_FileSystem._ParseUrl(ConvertToUrl(DefaultFile)).Path
1656 End If
1658 ' Set default values
1660 If oFileAccess.exists(sInitPath) Then .SetDisplayDirectory(sInitPath)
1661 sBaseFile = SF_FileSystem.GetName(DefaultFile)
1662 .setDefaultName(sBaseFile)
1664 ' Get selected file
1665 iAccept = .Execute()
1666 If iAccept = com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then sFile = .getSelectedFiles()(0)
1669 .dispose()
1671 End With
1673 Finally:
1674 PickFile = SF_FileSystem._ConvertFromUrl(sFile)
1675 SF_Utils._ExitFunction(cstThisSub)
1676 Exit Function
1677 Catch:
1678 GoTo Finally
1679 CatchNotSupported:
1680 SF_Exception.RaiseFatal(FILESYSTEMERROR, "DefaultFile", Split(cstThisSub, ".")(1), DefaultFile)
1681 GoTo Finally
1682 End Function ' ScriptForge.SF_FileSystem.PickFile
1684 REM -----------------------------------------------------------------------------
1685 Public Function PickFolder(Optional ByVal DefaultFolder As Variant _
1686 , Optional ByVal FreeText As Variant _
1687 ) As String
1688 ''' Display a FolderPicker dialog box
1690 ''' Args:
1691 ''' DefaultFolder: the FolderName from which to start. Default = the last selected folder
1693 ''' Returns:
1694 ''' The selected FolderName in URL or operating system format
1695 ''' The zero-length string if the dialog was cancelled
1696 ''' Exceptions:
1697 ''' FILESYSTEMERROR The method is not applicable on document's file systems
1698 ''' Example:
1700 ''' FSO.PickFolder("C:\", "Choose a folder or press Cancel")
1702 Dim oFolderDialog As Object ' com.sun.star.ui.dialogs.FolderPicker
1703 Dim iAccept As Integer ' Value returned by the dialog (OK, Cancel, ..)
1707 Const cstSubArgs = "[DefaultFolder=""""], [FreeText=""""]"
1709 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1710 sFolder = ""
1712 Check:
1713 If IsMissing(DefaultFolder) Or IsEmpty(DefaultFolder) Then DefaultFolder = ""
1714 If IsMissing(FreeText) Or IsEmpty(FreeText) Then FreeText = ""
1715 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1716 If Not SF_Utils._ValidateFile(DefaultFolder, "DefaultFolder", , True) Then GoTo Finally
1718 End If
1719 If SF_FileSystem._IsDocFileSystem(DefaultFolder) Then GoTo CatchNotSupported
1720 DefaultFolder = SF_FileSystem._ConvertToUrl(DefaultFolder)
1722 Try:
1724 If Not IsNull(oFolderDialog) Then
1725 With oFolderDialog
1727 .Description = FreeText
1728 iAccept = .Execute()
1729 ' https://api.libreoffice.org/docs/idl/ref/ExecutableDialogResults_8idl.html
1730 If iAccept = com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then
1731 .DisplayDirectory = .Directory ' Set the next default initial folder to the selected one
1733 End If
1734 End With
1735 End If
1737 Finally:
1738 PickFolder = SF_FileSystem._ConvertFromUrl(sFolder)
1739 SF_Utils._ExitFunction(cstThisSub)
1740 Exit Function
1741 Catch:
1742 GoTo Finally
1743 CatchNotSupported:
1744 SF_Exception.RaiseFatal(FILESYSTEMERROR, "DefaultFolder", Split(cstThisSub, ".")(1), DefaultFolder)
1745 GoTo Finally
1746 End Function ' ScriptForge.SF_FileSystem.PickFolder
1748 REM -----------------------------------------------------------------------------
1749 Public Function Properties() As Variant
1750 ''' Return the list or properties of the FileSystem module as an array
1752 Properties = Array( _
1761 )
1763 End Function ' ScriptForge.SF_FileSystem.Properties
1765 REM -----------------------------------------------------------------------------
1766 Public Function SetProperty(Optional ByVal PropertyName As Variant _
1767 , Optional ByRef Value As Variant _
1768 ) As Boolean
1769 ''' Set a new value to the given property
1770 ''' Args:
1771 ''' PropertyName: the name of the property as a string
1772 ''' Value: its new value
1773 ''' Exceptions
1774 ''' ARGUMENTERROR The property does not exist
1779 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1780 SetProperty = False
1782 Check:
1783 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1784 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
1785 End If
1787 Try:
1788 Select Case UCase(PropertyName)
1790 Case Else
1791 End Select
1793 Finally:
1794 SF_Utils._ExitFunction(cstThisSub)
1795 Exit Function
1796 Catch:
1797 GoTo Finally
1798 End Function ' ScriptForge.SF_FileSystem.SetProperty
1800 REM -----------------------------------------------------------------------------
1801 Public Function SubFolders(Optional ByVal FolderName As Variant _
1802 , Optional ByVal Filter As Variant _
1803 , Optional ByVal IncludeSubfolders As Variant _
1804 ) As Variant
1805 ''' Return an array of the FolderNames stored in the given folder. The folder must exist,
1806 ''' Subfolders may be optionally explored too.
1807 ''' Args:
1808 ''' FolderName: the folder to explore
1809 ''' Filter: contains wildcards ("?" and "*") to limit the list to the relevant folders (default = "")
1810 ''' IncludeSubfolders: when True (default = False), subfolders are explored too.
1811 ''' Returns:
1812 ''' An array of strings, each entry is the FolderName of an existing folder
1813 ''' Exceptions:
1814 ''' UNKNOWNFOLDERERROR Folder does not exist
1815 ''' NOTAFOLDERERROR FolderName is a file, not a folder
1816 ''' Example:
1817 ''' Dim a As Variant
1821 Dim vSubFolders As Variant ' Return value
1822 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
1823 Dim sFoldersColl As String ' cstSEPARATOR delimited string of list of folders (FileNaming notation)
1824 Dim i As Long
1827 Const cstSubArgs = "FolderName, [Filter=""""], [IncludeSubfolders=False]"
1829 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1830 vSubFolders = Array()
1832 Check:
1833 If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = ""
1834 If IsMissing(IncludeSubfolders) Or IsEmpty(IncludeSubfolders) Then IncludeSubfolders = False
1835 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1838 If Not SF_Utils._Validate(IncludeSubfolders, "IncludeSubfolders", V_BOOLEAN) Then GoTo Finally
1839 End If
1840 If SF_FileSystem.FileExists(FolderName) Then GoTo CatchFile ' Must not be a file
1841 If Not SF_FileSystem.FolderExists(FolderName) Then GoTo CatchFolder ' Top folder must exist
1843 Try:
1844 sFoldersColl = ""
1846 SF_FileSystem._ScanFolder(cstFolders, sFoldersColl, FolderName, oSfa, Filter, IncludeSubfolders)
1848 If Len(sFoldersColl) > Len(cstSEPARATOR) Then vSubFolders() = Split(Mid(sFoldersColl, Len(cstSEPARATOR) + 1), cstSEPARATOR)
1850 Finally:
1851 SubFolders = vSubFolders
1852 SF_Utils._ExitFunction(cstThisSub)
1853 Exit Function
1854 Catch:
1855 GoTo Finally
1856 CatchFile:
1858 GoTo Finally
1859 CatchFolder:
1861 GoTo Finally
1862 End Function ' ScriptForge.SF_FileSystem.SubFolders
1864 REM =========================================================== PRIVATE FUNCTIONS
1866 REM -----------------------------------------------------------------------------
1867 Private Function _ConvertFromUrl(psFile) As String
1868 ''' Execute the builtin ConvertFromUrl function only when relevant
1869 ''' i.e. when FileNaming (how arguments and return values are provided) = "SYS"
1870 ''' Called at the bottom of methods returning file names
1871 ''' Remarks: psFile might contain wildcards
1874 Const cstQuestion = "$QUESTION$", cstStar = "$STAR$" ' Special tokens to replace wildcards
1876 If SF_FileSystem.FileNaming = "SYS" And Not SF_FileSystem._IsDocFileSystem(psFile) Then
1877 _ConvertFromUrl = Replace(Replace( _
1880 Else
1881 _ConvertFromUrl = psFile
1882 End If
1884 End Function ' ScriptForge.FileSystem._ConvertFromUrl
1886 REM -----------------------------------------------------------------------------
1887 Private Function _ConvertToUrl(psFile) As String
1888 ''' Execute the builtin ConvertToUrl function only when relevant
1889 ''' i.e. when FileNaming (how arguments and return values are provided) <> "URL"
1890 ''' Called at the top of methods receiving file names as arguments
1891 ''' Remarks: psFile might contain wildcards
1895 _ConvertToUrl = psFile
1896 Else
1899 End If
1901 End Function ' ScriptForge.FileSystem._ConvertToUrl
1903 REM -----------------------------------------------------------------------------
1904 Private Function _CopyMove(psMethod As String _
1905 , psSource As String _
1906 , psDestination As String _
1907 , pbOverWrite As Boolean _
1908 ) As Boolean
1909 ''' Checks the arguments and executes the given method
1910 ''' Args:
1911 ''' psMethod: CopyFile/CopyFolder or MoveFile/MoveFolder
1912 ''' psSource: Either File/FolderName
1913 ''' or NamePattern which can include wildcard characters, for one or more files/folders to be copied
1914 ''' psDestination: FileName or FolderName for copy/move of a single file/folder
1915 ''' Otherwise a destination FolderName. If it does not exist, it is created
1916 ''' pbOverWrite: If True, files/folders may be overwritten
1917 ''' Must be False for Move operations
1918 ''' Next checks are done:
1919 ''' With wildcards (multiple files/folders):
1920 ''' - Parent folder of source must exist
1921 ''' - Destination must not be a file
1922 ''' - Parent folder of Destination must exist
1923 ''' - If the Destination folder does not exist a new folder is created,
1924 ''' - At least one file matches the wildcards expression
1925 ''' - Destination files/folder must not exist if pbOverWrite = False
1926 ''' - Destination files/folders must not have the read-only attribute set
1927 ''' - Destination files must not be folders, destination folders must not be files
1928 ''' Without wildcards (single file/folder):
1929 ''' - Source file/folder must exist and be a file/folder
1930 ''' - Parent folder of Destination must exist
1931 ''' - Destination must not be an existing folder/file
1932 ''' - Destination file/folder must not exist if pbOverWrite = False
1933 ''' - Destination file must not have the read-only attribute set
1935 Dim bCopyMove As Boolean ' Return value
1936 Dim bCopy As Boolean ' True if Copy, False if Move
1937 Dim bFile As Boolean ' True if File, False if Folder
1938 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
1939 Dim bWildCards As Boolean ' True if wildcards found in Source
1940 Dim bCreateFolder As Boolean ' True when the destination folder should be created
1941 Dim bDestExists As Boolean ' True if destination exists
1942 Dim sSourceUrl As String ' Alias for Source
1943 Dim sDestinationUrl As String ' Alias for Destination
1944 Dim sDestinationFile As String ' Destination FileName
1945 Dim sParentFolder As String ' Parent folder of Source
1946 Dim vFiles As Variant ' Array of candidates for copy/move
1947 Dim sFile As String ' Single file/folder
1948 Dim sName As String ' Name (last component) of file
1949 Dim i As Long
1951 ' Error handling left to calling routine
1952 bCopyMove = False
1955 bWildCards = ( InStr(psSource, "*") + InStr(psSource, "?") + InStr(psSource, "%3F") > 0 ) 'ConvertToUrl() converts sometimes "?" to "%3F"
1956 bDestExists = False
1958 With SF_FileSystem
1960 Check:
1961 If bWildCards Then
1962 sParentFolder = .GetParentFolderName(psSource)
1963 If Not .FolderExists(sParentFolder) Then GoTo CatchNoMatch
1964 If .FileExists(psDestination) Then GoTo CatchFileNotFolder
1965 If Not .FolderExists(.GetParentFolderName(psDestination)) Then GoTo CatchDestFolderNotExists
1966 bCreateFolder = Not .FolderExists(psDestination)
1967 Else
1968 Select Case bFile
1969 Case True ' File
1970 If Not .FileExists(psSource) Then GoTo CatchFileNotExists
1971 If Not .FolderExists(.GetParentFolderName(psDestination)) Then GoTo CatchDestFolderNotExists
1972 If .FolderExists(psDestination) Then GoTo CatchFolderNotFile
1973 bDestExists = .FileExists(psDestination)
1974 If pbOverWrite = False And bDestExists = True Then GoTo CatchDestinationExists
1975 bCreateFolder = False
1976 Case False ' Folder
1977 If Not .FolderExists(psSource) Then GoTo CatchSourceFolderNotExists
1978 If Not .FolderExists(.GetParentFolderName(psDestination)) Then GoTo CatchDestFolderNotExists
1979 If .FileExists(psDestination) Then GoTo CatchFileNotFolder
1980 bDestExists = .FolderExists(psDestination)
1981 If pbOverWrite = False And bDestExists Then GoTo CatchDestinationExists
1982 bCreateFolder = Not bDestExists
1983 End Select
1984 End If
1986 Try:
1988 If bWildCards Then
1989 If bFile Then vFiles = .Files(sParentFolder, .GetName(psSource)) Else vFiles = .SubFolders(sParentFolder, .GetName(psSource))
1991 ' Go through the candidates
1992 If bCreateFolder Then .CreateFolder(psDestination)
1993 For i = 0 To UBound(vFiles)
1994 sFile = vFiles(i)
1995 sDestinationFile = .BuildPath(psDestination, .GetName(sFile))
1996 If bFile Then bDestExists = .FileExists(sDestinationFile) Else bDestExists = .FolderExists(sDestinationFile)
1997 If pbOverWrite = False Then
1998 If bDestExists Then GoTo CatchDestinationExists
1999 If .FolderExists(sDestinationFile) Then GoTo CatchDestinationExists
2000 End If
2001 sSourceUrl = ._ConvertToUrl(sFile)
2002 sDestinationUrl = ._ConvertToUrl(sDestinationFile)
2003 If bDestExists Then
2004 If oSfa.isReadOnly(sDestinationUrl) Then GoTo CatchDestinationReadOnly
2005 End If
2006 Select Case bCopy
2007 Case True : oSfa.copy(sSourceUrl, sDestinationUrl)
2008 Case False : oSfa.move(sSourceUrl, sDestinationUrl)
2009 End Select
2010 Next i
2011 Else
2012 sSourceUrl = ._ConvertToUrl(psSource)
2013 sDestinationUrl = ._ConvertToUrl(psDestination)
2014 If bDestExists Then
2015 If oSfa.isReadOnly(sDestinationUrl) Then GoTo CatchDestinationReadOnly
2016 End If
2017 If bCreateFolder Then .CreateFolder(psDestination)
2018 Select Case bCopy
2019 Case True : oSfa.copy(sSourceUrl, sDestinationUrl)
2020 Case False : oSfa.move(sSourceUrl, sDestinationUrl)
2021 End Select
2022 End If
2024 End With
2026 bCopyMove = True
2028 Finally:
2029 _CopyMove = bCopyMove
2030 Exit Function
2031 CatchFileNotExists:
2033 GoTo Finally
2034 CatchSourceFolderNotExists:
2036 GoTo Finally
2037 CatchDestFolderNotExists:
2039 GoTo Finally
2040 CatchFolderNotFile:
2042 GoTo Finally
2043 CatchDestinationExists:
2045 GoTo Finally
2046 CatchNoMatch:
2048 GoTo Finally
2049 CatchFileNotFolder:
2051 GoTo Finally
2052 CatchDestinationReadOnly:
2053 SF_Exception.RaiseFatal(READONLYERROR, "Destination", Iif(bWildCards, sDestinationFile, psDestination))
2054 GoTo Finally
2055 End Function ' ScriptForge.SF_FileSystem._CopyMove
2057 REM -----------------------------------------------------------------------------
2058 Public Function _CountTextLines(ByVal psFileName As String _
2059 , Optional ByVal pbIncludeBlanks As Boolean _
2060 ) As Long
2061 ''' Convenient function to count the number of lines in a textfile
2062 ''' Args:
2063 ''' psFileName: the file in FileNaming notation
2064 ''' pbIncludeBlanks: if True (default), zero-length lines are included
2065 ''' Returns:
2068 Dim lLines As Long ' Return value
2069 Dim oFile As Object ' File handler
2070 Dim sLine As String ' The last line read
2072 Try:
2073 lLines = 0
2074 If IsMissing(pbIncludeBlanks) Then pbIncludeBlanks = True
2075 Set oFile = SF_FileSystem.OpenTextFile(psFileName, ForReading)
2076 With oFile
2077 If Not IsNull(oFile) Then
2078 Do While Not .AtEndOfStream
2079 sLine = .ReadLine()
2081 Loop
2082 End If
2083 .CloseFile()
2084 Set oFile = .Dispose()
2085 End With
2087 Finally:
2088 _CountTextLines = lLines
2089 Exit Function
2090 End Function ' ScriptForge.SF_FileSystem._CountTextLines
2092 REM -----------------------------------------------------------------------------
2093 Private Function _Delete(psMethod As String _
2094 , psFile As String _
2095 ) As Boolean
2096 ''' Checks the argument and executes the given psMethod
2097 ''' Args:
2098 ''' psMethod: CopyFile/CopyFolder or MoveFile/MoveFolder
2099 ''' psFile: Either File/FolderName
2100 ''' or NamePattern which can include wildcard characters, for one or more files/folders to be deleted
2101 ''' Next checks are done:
2102 ''' With wildcards (multiple files/folders):
2103 ''' - Parent folder of File must exist
2104 ''' - At least one file matches the wildcards expression
2105 ''' - Files or folders to delete must not have the read-only attribute set
2106 ''' Without wildcards (single file/folder):
2107 ''' - File/folder must exist and be a file/folder
2108 ''' - A file or folder to delete must not have the read-only attribute set
2110 Dim bDelete As Boolean ' Return value
2111 Dim bFile As Boolean ' True if File, False if Folder
2112 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
2113 Dim bWildCards As Boolean ' True if wildcards found in File
2114 Dim sFileUrl As String ' Alias for File
2115 Dim sParentFolder As String ' Parent folder of File
2116 Dim vFiles As Variant ' Array of candidates for deletion
2117 Dim sFile As String ' Single file/folder
2118 Dim sName As String ' Name (last component) of file
2119 Dim i As Long
2121 ' Error handling left to calling routine
2122 bDelete = False
2124 bWildCards = ( InStr(psFile, "*") + InStr(psFile, "?") + InStr(psFile, "%3F") > 0 ) 'ConvertToUrl() converts sometimes "?" to "%3F"
2126 With SF_FileSystem
2128 Check:
2129 If bWildCards Then
2130 sParentFolder = .GetParentFolderName(psFile)
2131 If Not .FolderExists(sParentFolder) Then GoTo CatchNoMatch
2132 Else
2133 Select Case bFile
2134 Case True ' File
2135 If .FolderExists(psFile) Then GoTo CatchFolderNotFile
2136 If Not .FileExists(psFile) Then GoTo CatchFileNotExists
2137 Case False ' Folder
2138 If .FileExists(psFile) Then GoTo CatchFileNotFolder
2139 If Not .FolderExists(psFile) Then GoTo CatchFolderNotExists
2140 End Select
2141 End If
2143 Try:
2145 If bWildCards Then
2146 If bFile Then vFiles = .Files(sParentFolder) Else vFiles = .SubFolders(sParentFolder)
2147 ' Select candidates
2148 For i = 0 To UBound(vFiles)
2149 If Not SF_String.IsLike(.GetName(vFiles(i)), .GetName(psFile)) Then vFiles(i) = ""
2150 Next i
2151 vFiles = SF_Array.TrimArray(vFiles)
2153 ' Go through the candidates
2154 For i = 0 To UBound(vFiles)
2155 sFile = vFiles(i)
2156 sFileUrl = ._ConvertToUrl(sFile)
2157 If oSfa.isReadOnly(sFileUrl) Then GoTo CatchReadOnly
2158 oSfa.kill(sFileUrl)
2159 Next i
2160 Else
2161 sFileUrl = ._ConvertToUrl(psFile)
2162 If oSfa.isReadOnly(sFileUrl) Then GoTo CatchReadOnly
2163 oSfa.kill(sFileUrl)
2164 End If
2166 End With
2168 bDelete = True
2170 Finally:
2171 _Delete = bDelete
2172 Exit Function
2173 CatchFolderNotExists:
2175 GoTo Finally
2176 CatchFileNotExists:
2178 GoTo Finally
2179 CatchFolderNotFile:
2181 GoTo Finally
2182 CatchNoMatch:
2183 SF_Exception.RaiseFatal(NOFILEMATCHERROR, Iif(bFile, "FileName", "FolderName"), psFile)
2184 GoTo Finally
2185 CatchFileNotFolder:
2187 GoTo Finally
2188 CatchReadOnly:
2189 SF_Exception.RaiseFatal(READONLYERROR, Iif(bFile, "FileName", "FolderName"), Iif(bWildCards, sFile, psFile))
2190 GoTo Finally
2191 End Function ' ScriptForge.SF_FileSystem._Delete
2193 REM -----------------------------------------------------------------------------
2194 Private Function _GetConfigFolder(ByVal psFolder As String) As String
2195 ''' Returns one of next configuration folders: see https://api.libreoffice.org/docs/idl/ref/servicecom_1_1sun_1_1star_1_1util_1_1PathSubstitution.html
2199 ''' work => The work directory of the user. Under Windows this would be the "MyDocuments" subdirectory. Under Unix this would be the home-directory
2200 ''' home => The home directory of the user. Under Unix this would be the home- directory.
2201 ''' Under Windows this would be the CSIDL_PERSONAL directory, for example "Documents and Settings\<username>\Documents"
2204 Dim oSubst As Object ' com.sun.star.util.PathSubstitution
2205 Dim sConfig As String ' Return value
2207 sConfig = ""
2209 If Not IsNull(oSubst) Then sConfig = oSubst.getSubstituteVariableValue("$(" & psFolder & ")") & "/"
2211 _GetConfigFolder = SF_FileSystem._ConvertFromUrl(sConfig)
2213 End Function ' ScriptForge.FileSystem._GetConfigFolder
2215 REM -----------------------------------------------------------------------------
2216 Public Function _IsDocFileSystem(psFile As String) As Boolean
2217 ''' Returns True when the argument designates a document's internal file system
2219 _IsDocFileSystem = SF_String.StartsWith(psFile, DOCFILESYSTEM, CaseSensitive := True)
2221 End Function ' ScriptForge.SF_FileSystem._IsDocFileSystem
2223 REM -----------------------------------------------------------------------------
2224 Private Sub _ScanFolder(ByVal piTarget As Integer _
2225 , ByRef psItemsColl As String _
2226 , ByVal psFolderName As String _
2227 , ByRef poSfa As Object _
2228 , ByVal psFilter As String _
2229 , ByVal pbIncludeSubFolders As Boolean _
2230 )
2231 ''' Scan a folder and, when requested, its subfolders recursively.
2232 ''' The psItemsColl in-out argument concatenates, depending on the target,
2233 ''' either all files or all folders found.
2234 ''' The Sub calls itself recursively when relevant.
2235 ''' Args:
2236 ''' piTarget: 1 when caller routine = Files(), 2 when caller routine = SubFolders()
2237 ''' It determines the type of items to collect: files or folders
2238 ''' psItemsColl: the current and future list of folders or files (FileNaming format) separated with cstSEPARATOR
2239 ''' psFolderName: the folder to scan (FileNaming format)
2240 ''' poSfa: com.sun.star.ucb.SimpleFileAccess
2241 ''' psFilter: contains wildcards ("?" and "*") to limit the list to the relevant folders or files.
2242 ''' Zero-length string when not applicable.
2243 ''' pbIncludeSubfolders: when True, subfolders are explored too.
2246 Dim vFiles As Variant ' Array of files present in psFolderName in FileNaming notation
2247 Dim lFiles As Long ' Number of files found passing the filter
2248 Dim sFolderName As String ' URL alias for psFolderName
2249 Dim sItem As String ' Single folder or single file in FileNaming notation
2250 Dim sItemName As String ' Base name of sItem
2251 Dim bFolder As Boolean ' When True, the considered string points to a folder, not a file
2252 Dim bFilter As Boolean ' When True, no filter or the filter is passed
2253 Dim i As Long
2255 Check:
2256 On Local Error Goto catch
2258 Try:
2259 With poSfa
2261 ' Get SubFolders, initialize files list
2262 sFolderName = SF_FileSystem._ConvertToUrl(psFolderName)
2263 vSubFolders = .getFolderContents(sFolderName, True)
2265 vFiles = Array()
2266 If piTarget = cstFiles Then
2267 lFiles = 0
2268 ReDim vFiles(0 To UBound(vSubFolders))
2269 End If
2271 ' List includes files: remove them or adjust notations of folders
2272 ' When piTarget = cstFiles, the list of files is stored in the vFiles() array
2273 For i = 0 To UBound(vSubFolders)
2274 sItem = SF_FileSystem._ConvertFromUrl(vSubFolders(i))
2275 bFolder = .isFolder(vSubFolders(i))
2276 Select Case piTarget
2277 Case cstFiles
2278 If bFolder Then
2280 Else
2281 ' Build list of files passing the filter
2282 bFilter = ( Len(psFilter) = 0 )
2283 If Not bFilter Then
2284 sItemName = SF_FileSystem.GetName(sItem)
2285 bFilter = SF_String.IsLike(sItemName, psFilter)
2286 End If
2287 If bFilter Then ' Copy files from folders + files list
2288 vFiles(lFiles) = sItem
2289 lFiles = lFiles + 1
2290 End If
2291 vSubFolders(i) = "" ' Keep folders only
2292 End If
2293 Case cstFolders
2295 ' Reduce list to those passing the filter
2297 sItemName = SF_FileSystem.GetName(sItem)
2298 If Not SF_String.IsLike(sItemName, psFilter) Then vSubFolders(i) = ""
2299 End If
2300 End Select
2301 Next i
2302 vSubFolders = SF_Array.TrimArray(vSubFolders)
2304 ' Store the list of either files or subfolders in the global collection
2305 Select Case piTarget
2306 Case cstFiles
2310 End If
2311 Case cstFolders
2312 If UBound(vSubFolders) >= 0 Then psItemsColl = psItemsColl & cstSEPARATOR & Join(vSubFolders, cstSEPARATOR)
2313 End Select
2315 ' Scan each subfolder when relevant
2316 If pbIncludeSubfolders Then
2317 For i = 0 To UBound(vSubFolders)
2318 _ScanFolder(piTarget, psItemsColl, vSubFolders(i), poSfa, psFilter, True)
2319 Next i
2320 End If
2322 End With
2324 Finally:
2325 Exit Sub
2326 Catch:
2327 SF_Exception.Clear()
2328 psItemsColl = ""
2329 GoTo Finally
2330 End Sub ' ScriptForge.SF_FileSystem._ScanFolder
2332 REM -----------------------------------------------------------------------------
2333 Public Function _ParseUrl(psUrl As String) As Object
2334 ''' Returns a com.sun.star.util.URL structure based on the argument
2336 Dim oParse As Object ' com.sun.star.util.URLTransformer
2337 Dim bParsed As Boolean ' True if parsing is successful
2338 Dim oUrl As New com.sun.star.util.URL ' Return value
2340 oUrl.Complete = psUrl
2342 bParsed = oParse.parseStrict(oUrl, "")
2343 If bParsed Then oUrl.Path = ConvertToUrl(oUrl.Path)
2345 Set _ParseUrl = oUrl
2347 End Function ' ScriptForge.SF_FileSystem._ParseUrl
2349 REM -----------------------------------------------------------------------------
2350 Public Function _SFInstallFolder() As String
2351 ''' Returns the installation folder of the ScriptForge library
2352 ''' Either:
2354 ''' ($config)/basic/ScriptForge
2356 ''' ($install)/share/basic/ScriptForge
2358 Dim sFolder As String ' Folder
2360 _SFInstallFolder = ""
2363 If Not FolderExists(sFolder) Then
2365 If Not FolderExists(sFolder) Then Exit Function
2366 End If
2368 _SFInstallFolder = _ConvertFromUrl(sFolder)
2370 End Function ' ScriptForge.SF_FileSystem._SFInstallFolder
2372 REM ============================================ END OF SCRIPTFORGE.SF_FileSystem
2373 </script:module>