| blob | d81465dbff13cf501700392a9f55ba0ed684ef1b |
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 "URL" (default) 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 '''
40 ''' Service invocation example:
41 ''' Dim FSO As Variant
43 '''
44 ''' Detailed user documentation:
45 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_filesystem.html?DbPAR=BASIC
46 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
48 REM ================================================================== EXCEPTIONS
51 Const UNKNOWNFOLDERERROR = "UNKNOWNFOLDERERROR" ' Source folder or Destination folder does not exist
55 Const READONLYERROR = "READONLYERROR" ' Destination has its read-only attribute set
56 Const NOFILEMATCHERROR = "NOFILEMATCHFOUND" ' No file matches Source containing wildcards
57 Const FOLDERCREATIONERROR = "FOLDERCREATIONERROR" ' FolderName is an existing folder or file
59 REM ============================================================ MODULE CONSTANTS
61 ''' TextStream open modes
62 Const cstForReading = 1
63 Const cstForWriting = 2
64 Const cstForAppending = 8
66 REM ===================================================== CONSTRUCTOR/DESTRUCTOR
68 REM -----------------------------------------------------------------------------
69 Public Function Dispose() As Variant
70 Set Dispose = Nothing
71 End Function ' ScriptForge.SF_FileSystem Explicit destructor
73 REM ================================================================== PROPERTIES
75 REM -----------------------------------------------------------------------------
76 Property Get ConfigFolder() As String
77 ''' Return the configuration folder of LibreOffice
81 SF_Utils._EnterFunction(cstThisSub)
83 SF_Utils._ExitFunction(cstThisSub)
85 End Property ' ScriptForge.SF_FileSystem.ConfigFolder
87 REM -----------------------------------------------------------------------------
88 Property Get ExtensionsFolder() As String
89 ''' Return the folder containing the extensions installed for the current user
91 Dim oMacro As Object ' /singletons/com.sun.star.util.theMacroExpander
94 SF_Utils._EnterFunction(cstThisSub)
96 ExtensionsFolder = SF_FileSystem._ConvertFromUrl(oMacro.ExpandMacros("$UNO_USER_PACKAGES_CACHE") & "/")
97 SF_Utils._ExitFunction(cstThisSub)
99 End Property ' ScriptForge.SF_FileSystem.ExtensionsFolder
101 REM -----------------------------------------------------------------------------
102 Property Get FileNaming() As Variant
103 ''' Return the current files and folder notation, either "ANY", "URL" or "SYS"
104 ''' "ANY": methods receive either URL or native file names, but always return URL file names
105 ''' "URL": methods expect URL arguments and return URL strings (when relevant)
109 SF_Utils._EnterFunction(cstThisSub)
110 FileNaming = _SF_.FileSystemNaming
111 SF_Utils._ExitFunction(cstThisSub)
113 End Property ' ScriptForge.SF_FileSystem.FileNaming (get)
115 REM -----------------------------------------------------------------------------
116 Property Let FileNaming(ByVal pvNotation As Variant)
117 ''' Set the files and folders notation: "ANY", "URL" or "SYS"
120 SF_Utils._EnterFunction(cstThisSub)
121 If VarType(pvNotation) = V_STRING Then
122 Select Case UCase(pvNotation)
123 Case "ANY", "URL", "SYS" : _SF_.FileSystemNaming = UCase(pvNotation)
124 Case Else ' Unchanged
125 End Select
126 End If
127 SF_Utils._ExitFunction(cstThisSub)
129 End Property ' ScriptForge.SF_FileSystem.FileNaming (let)
131 REM -----------------------------------------------------------------------------
132 Property Get ForAppending As Integer
133 ''' Convenient constant (see documentation)
134 ForAppending = cstForAppending
135 End Property ' ScriptForge.SF_FileSystem.ForAppending
137 REM -----------------------------------------------------------------------------
138 Property Get ForReading As Integer
139 ''' Convenient constant (see documentation)
140 ForReading = cstForReading
141 End Property ' ScriptForge.SF_FileSystem.ForReading
143 REM -----------------------------------------------------------------------------
144 Property Get ForWriting As Integer
145 ''' Convenient constant (see documentation)
146 ForWriting = cstForWriting
147 End Property ' ScriptForge.SF_FileSystem.ForWriting
149 REM -----------------------------------------------------------------------------
150 Property Get HomeFolder() As String
151 ''' Return the user home folder
155 SF_Utils._EnterFunction(cstThisSub)
157 SF_Utils._ExitFunction(cstThisSub)
159 End Property ' ScriptForge.SF_FileSystem.HomeFolder
161 REM -----------------------------------------------------------------------------
162 Property Get InstallFolder() As String
163 ''' Return the installation folder of LibreOffice
167 SF_Utils._EnterFunction(cstThisSub)
169 SF_Utils._ExitFunction(cstThisSub)
171 End Property ' ScriptForge.SF_FileSystem.InstallFolder
173 REM -----------------------------------------------------------------------------
174 Property Get ObjectType As String
175 ''' Only to enable object representation
177 End Property ' ScriptForge.SF_FileSystem.ObjectType
179 REM -----------------------------------------------------------------------------
180 Property Get ServiceName As String
181 ''' Internal use
183 End Property ' ScriptForge.SF_FileSystem.ServiceName
185 REM -----------------------------------------------------------------------------
186 Property Get TemplatesFolder() As String
187 ''' Return the folder defined in the LibreOffice paths options as intended for templates files
189 Dim sPath As String ' Template property of com.sun.star.util.PathSettings
192 SF_Utils._EnterFunction(cstThisSub)
194 TemplatesFolder = SF_FileSystem._ConvertFromUrl(Split(sPath, ";")(0) & "/")
195 SF_Utils._ExitFunction(cstThisSub)
197 End Property ' ScriptForge.SF_FileSystem.TemplatesFolder
199 REM -----------------------------------------------------------------------------
200 Property Get TemporaryFolder() As String
201 ''' Return the folder defined in the LibreOffice paths options as intended for temporary files
205 SF_Utils._EnterFunction(cstThisSub)
207 SF_Utils._ExitFunction(cstThisSub)
209 End Property ' ScriptForge.SF_FileSystem.TemporaryFolder
211 REM -----------------------------------------------------------------------------
212 Property Get UserTemplatesFolder() As String
213 ''' Return the folder defined in the LibreOffice paths options as intended for User templates files
215 Dim sPath As String ' Template_writable property of com.sun.star.util.PathSettings
218 SF_Utils._EnterFunction(cstThisSub)
221 SF_Utils._ExitFunction(cstThisSub)
223 End Property ' ScriptForge.SF_FileSystem.UserTemplatesFolder
225 REM ===================================================================== METHODS
227 REM -----------------------------------------------------------------------------
228 Public Function BuildPath(Optional ByVal FolderName As Variant _
229 , Optional ByVal Name As Variant _
230 ) As String
231 ''' Combines a folder path and the name of a file and returns the combination with a valid path separator
232 ''' Inserts an additional path separator between the foldername and the name, only if necessary
233 ''' Args:
234 ''' FolderName: Path with which Name is combined. Path need not specify an existing folder
235 ''' Name: To be appended to the existing path.
236 ''' Returns:
237 ''' The path concatenated with the file name after insertion of a path separator, if necessary
238 ''' Example:
239 ''' Dim a As String
241 ''' a = FSO.BuildPath("C:\Windows", "Notepad.exe") returns C:\Windows\Notepad.exe
243 Dim sBuild As String ' Return value
244 Dim sFile As String ' Alias for Name
249 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
250 sBuild = ""
252 Check:
253 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
256 End If
257 FolderName = SF_FileSystem._ConvertToUrl(FolderName)
259 Try:
260 ' Add separator if necessary. FolderName is now in URL notation
262 If Right(FolderName, 1) <> "/" Then sBuild = FolderName & "/" Else sBuild = FolderName
263 Else
264 sBuild = cstFileProtocol
265 End If
266 ' Encode the file name
267 sFile = ConvertToUrl(Name)
268 ' Some file names produce http://file.name.suffix/
269 If Left(sFile, 7) = "http://" Then sFile = cstFileProtocol & Mid(sFile, 8, Len(sFile) - 8)
270 ' Combine both parts
271 If Left(sFile, Len(cstFileProtocol)) = cstFileProtocol Then sBuild = sBuild & Mid(sFile, Len(cstFileProtocol) + 1) Else sBuild = sBuild & sFile
273 Finally:
274 BuildPath = SF_FileSystem._ConvertFromUrl(sBuild)
275 SF_Utils._ExitFunction(cstThisSub)
276 Exit Function
277 Catch:
278 GoTo Finally
279 End Function ' ScriptForge.SF_FileSystem.BuildPath
281 REM -----------------------------------------------------------------------------
282 Public Function CompareFiles(Optional ByVal FileName1 As Variant _
283 , Optional ByVal FileName2 As Variant _
284 , Optional ByVal CompareContents As Variant _
285 )
287 ''' The comparison may be based on the file attributes, like modification time,
288 ''' or on their contents.
289 ''' Args:
292 ''' CompareContents: When True, the contents of the files are compared. Default = False
293 ''' Returns:
294 ''' True when the files seem identical
295 ''' Exceptions:
296 ''' UNKNOWNFILEERROR One of the files does not exist
297 ''' Example:
299 ''' MsgBox FSO.CompareFiles("C:\myFile1.txt", "C:\myFile2.txt", CompareContents := True)
301 Dim bCompare As Boolean ' Return value
309 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
310 bCompare = False
312 Check:
313 If IsMissing(CompareContents) Or IsEmpty(CompareContents) Then CompareContents = False
314 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
317 If Not SF_Utils._Validate(CompareContents, "CompareContents", V_BOOLEAN) Then GoTo Finally
318 End If
319 ' Do the files exist ? Otherwise raise error
320 sFile = FileName1 : iFile = 1
321 If Not SF_FileSystem.FileExists(sFile) Then GoTo CatchNotExists
322 sFile = FileName2 : iFile = 2
323 If Not SF_FileSystem.FileExists(sFile) Then GoTo CatchNotExists
325 Try:
326 With ScriptForge.SF_Session
327 bCompare = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _
328 , _ConvertFromUrl(FileName1) _
329 , _ConvertFromUrl(FileName2) _
330 , CompareContents)
331 End With
333 Finally:
334 CompareFiles = bCompare
335 SF_Utils._ExitFunction(cstThisSub)
336 Exit Function
337 Catch:
338 GoTo Finally
339 CatchNotExists:
341 GoTo Finally
342 End Function ' ScriptForge.SF_FileSystem.CompareFiles
344 REM -----------------------------------------------------------------------------
345 Public Function CopyFile(Optional ByVal Source As Variant _
346 , Optional ByVal Destination As Variant _
347 , Optional ByVal Overwrite As Variant _
348 ) As Boolean
349 ''' Copies one or more files from one location to another
350 ''' Args:
351 ''' Source: FileName or NamePattern which can include wildcard characters, for one or more files to be copied
352 ''' Destination: FileName where the single Source file is to be copied
353 ''' or FolderName where the multiple files from Source are to be copied
354 ''' If FolderName does not exist, it is created
355 ''' Anyway, wildcard characters are not allowed in Destination
356 ''' Overwrite: If True (default), files may be overwritten
357 ''' CopyFile will fail if Destination has the read-only attribute set, regardless of the value of Overwrite.
358 ''' Returns:
359 ''' True if at least one file has been copied
360 ''' False if an error occurred
361 ''' An error also occurs if a source using wildcard characters doesn't match any files.
362 ''' The method stops on the first error it encounters
363 ''' No attempt is made to roll back or undo any changes made before an error occurs
364 ''' Exceptions:
365 ''' UNKNOWNFILEERROR Source does not exist
366 ''' UNKNOWNFOLDERERROR Source folder or Destination folder does not exist
367 ''' NOFILEMATCHERROR No file matches Source containing wildcards
368 ''' NOTAFOLDERERROR Destination is a file, not a folder
369 ''' NOTAFILEERROR Destination is a folder, not a file
370 ''' OVERWRITEERROR Destination can not be overwritten
371 ''' READONLYERROR Destination has its read-only attribute set
372 ''' Example:
374 ''' FSO.CopyFile("C:\Windows\*.*", "C:\Temp\", Overwrite := False) ' Only files are copied, subfolders are not
376 Dim bCopy As Boolean ' Return value
381 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
382 bCopy = False
384 Check:
385 If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = True
386 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
390 End If
392 Try:
395 Finally:
396 CopyFile = bCopy
397 SF_Utils._ExitFunction(cstThisSub)
398 Exit Function
399 Catch:
400 GoTo Finally
401 End Function ' ScriptForge.SF_FileSystem.CopyFile
403 REM -----------------------------------------------------------------------------
404 Public Function CopyFolder(Optional ByVal Source As Variant _
405 , Optional ByVal Destination As Variant _
406 , Optional ByVal Overwrite As Variant _
407 ) As Boolean
408 ''' Copies one or more folders from one location to another
409 ''' Args:
410 ''' Source: FolderName or NamePattern which can include wildcard characters, for one or more folders to be copied
411 ''' Destination: FolderName where the single Source folder is to be copied
412 ''' or FolderName where the multiple folders from Source are to be copied
413 ''' If FolderName does not exist, it is created
414 ''' Anyway, wildcard characters are not allowed in Destination
415 ''' Overwrite: If True (default), folders and their content may be overwritten
416 ''' CopyFile will fail if Destination has the read-only attribute set, regardless of the value of Overwrite.
417 ''' Returns:
418 ''' True if at least one folder has been copied
419 ''' False if an error occurred
420 ''' An error also occurs if a source using wildcard characters doesn't match any folders.
421 ''' The method stops on the first error it encounters
422 ''' No attempt is made to roll back or undo any changes made before an error occurs
423 ''' Exceptions:
424 ''' UNKNOWNFILEERROR Source does not exist
425 ''' UNKNOWNFOLDERERROR Source folder or Destination folder does not exist
426 ''' NOFILEMATCHERROR No file matches Source containing wildcards
427 ''' NOTAFOLDERERROR Destination is a file, not a folder
428 ''' OVERWRITEERROR Destination can not be overwritten
429 ''' READONLYERROR Destination has its read-only attribute set
430 ''' Example:
432 ''' FSO.CopyFolder("C:\Windows\*", "C:\Temp\", Overwrite := False)
434 Dim bCopy As Boolean ' Return value
439 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
440 bCopy = False
442 Check:
443 If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = True
444 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
448 End If
450 Try:
453 Finally:
454 CopyFolder = bCopy
455 SF_Utils._ExitFunction(cstThisSub)
456 Exit Function
457 Catch:
458 GoTo Finally
459 End Function ' ScriptForge.SF_FileSystem.CopyFolder
461 REM -----------------------------------------------------------------------------
462 Public Function CreateFolder(Optional ByVal FolderName As Variant) As Boolean
463 ''' Return True if the given folder name could be created successfully
464 ''' The parent folder does not need to exist beforehand
465 ''' Args:
466 ''' FolderName: a string representing the folder to create. It must not exist
467 ''' Returns:
468 ''' True if FolderName is a valid folder name, does not exist and creation was successful
469 ''' False otherwise including when FolderName is a file
470 ''' Exceptions:
471 ''' FOLDERCREATIONERROR FolderName is an existing folder or file
472 ''' Example:
476 Dim bCreate As Boolean ' Return value
477 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
482 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
483 bCreate = False
485 Check:
486 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
488 End If
490 Try:
492 If SF_FileSystem.FolderExists(FolderName) Then GoTo CatchExists
493 If SF_FileSystem.FileExists(FolderName) Then GoTo CatchExists
494 oSfa.createFolder(SF_FileSystem._ConvertToUrl(FolderName))
495 bCreate = True
497 Finally:
498 CreateFolder = bCreate
499 SF_Utils._ExitFunction(cstThisSub)
500 Exit Function
501 Catch:
502 GoTo Finally
503 CatchExists:
505 GoTo Finally
506 End Function ' ScriptForge.SF_FileSystem.CreateFolder
508 REM -----------------------------------------------------------------------------
509 Public Function CreateTextFile(Optional ByVal FileName As Variant _
510 , Optional ByVal Overwrite As Variant _
511 , Optional ByVal Encoding As Variant _
512 ) As Object
513 ''' Creates a specified file and returns a TextStream object that can be used to write to the file
514 ''' Args:
515 ''' FileName: Identifies the file to create
516 ''' Overwrite: Boolean value that indicates if an existing file can be overwritten (default = True)
517 ''' Encoding: The character set that should be used
518 ''' Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml
519 ''' Note that LibreOffice does not implement all existing sets
521 ''' Returns:
522 ''' An instance of the SF_TextStream class representing the opened file or a Null object if an error occurred
523 ''' It doesn't check either if the given encoding is implemented in LibreOffice
524 ''' Exceptions:
525 ''' OVERWRITEERROR File exists, creation impossible
526 ''' Example:
527 ''' Dim myFile As Object
529 ''' Set myFile = FSO.CreateTextFile("C:\Temp\ThisFile.txt", Overwrite := True)
531 Dim oTextStream As Object ' Return value
533 Const cstSubArgs = "FileName, [Overwrite=True], [Encoding=""UTF-8""]"
535 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
536 Set oTextStream = Nothing
538 Check:
539 If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = True
541 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
545 End If
547 With SF_FileSystem
548 If .FileExists(FileName) Then
549 If Overwrite Then .DeleteFile(FileName) Else GoTo CatchOverWrite
550 End If
552 Try:
553 Set oTextStream = .OpenTextFile(FileName, .ForWriting, Create := True, Encoding := Encoding)
554 End With
556 Finally:
557 Set CreateTextFile = oTextStream
558 SF_Utils._ExitFunction(cstThisSub)
559 Exit Function
560 Catch:
561 GoTo Finally
562 CatchOverWrite:
564 GoTo Finally
565 End Function ' ScriptForge.SF_FileSystem.CreateTextFile
567 REM -----------------------------------------------------------------------------
568 Public Function DeleteFile(Optional ByVal FileName As Variant) As Boolean
569 ''' Deletes one or more files
570 ''' Args:
571 ''' FileName: FileName or NamePattern which can include wildcard characters, for one or more files to be deleted
572 ''' Returns:
573 ''' True if at least one file has been deleted
574 ''' False if an error occurred
575 ''' An error also occurs if a FileName using wildcard characters doesn't match any files.
576 ''' The method stops on the first error it encounters
577 ''' No attempt is made to roll back or undo any changes made before an error occurs
578 ''' Exceptions:
579 ''' UNKNOWNFILEERROR FileName does not exist
580 ''' NOFILEMATCHERROR No file matches FileName containing wildcards
581 ''' NOTAFILEERROR Argument is a folder, not a file
582 ''' Example:
584 ''' FSO.DeleteFile("C:\Temp\*.*") ' Only files are deleted, subfolders are not
586 Dim bDelete As Boolean ' Return value
591 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
592 bDelete = False
594 Check:
595 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
597 End If
599 Try:
602 Finally:
603 DeleteFile = bDelete
604 SF_Utils._ExitFunction(cstThisSub)
605 Exit Function
606 Catch:
607 GoTo Finally
608 End Function ' ScriptForge.SF_FileSystem.DeleteFile
610 REM -----------------------------------------------------------------------------
611 Public Function DeleteFolder(Optional ByVal FolderName As Variant) As Boolean
612 ''' Deletes one or more Folders
613 ''' Args:
614 ''' FolderName: FolderName or NamePattern which can include wildcard characters, for one or more Folders to be deleted
615 ''' Returns:
616 ''' True if at least one folder has been deleted
617 ''' False if an error occurred
618 ''' An error also occurs if a FolderName using wildcard characters doesn't match any folders.
619 ''' The method stops on the first error it encounters
620 ''' No attempt is made to roll back or undo any changes made before an error occurs
621 ''' Exceptions:
622 ''' UNKNOWNFOLDERERROR FolderName does not exist
623 ''' NOFILEMATCHERROR No folder matches FolderName containing wildcards
624 ''' NOTAFOLDERERROR Argument is a file, not a folder
625 ''' Example:
627 ''' FSO.DeleteFolder("C:\Temp\*") ' Only folders are deleted, files in the parent folder are not
629 Dim bDelete As Boolean ' Return value
634 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
635 bDelete = False
637 Check:
638 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
640 End If
642 Try:
645 Finally:
646 DeleteFolder = bDelete
647 SF_Utils._ExitFunction(cstThisSub)
648 Exit Function
649 Catch:
650 GoTo Finally
651 End Function ' ScriptForge.SF_FileSystem.DeleteFolder
653 REM -----------------------------------------------------------------------------
654 Public Function ExtensionFolder(Optional ByVal Extension As Variant) As String
655 ''' Return the folder where the given extension is installed. The argument must
656 ''' be in the list of extensions provided by the SF_Platform.Extensions property
657 ''' Args:
658 ''' Extension: a valid extension name
659 ''' Returns:
660 ''' The requested folder using the FileNaming notation
661 ''' Example:
664 Dim sFolder As String ' Return value
665 Static vExtensions As Variant ' Cached list of existing extension names
666 Dim oPackage As Object ' /singletons/com.sun.star.deployment.PackageInformationProvider
670 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
671 sFolder = ""
673 Check:
674 If IsEmpty(vExtensions) Then vExtensions = SF_Platform.Extensions
675 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
676 If Not SF_Utils._Validate(Extension, "Extension", V_STRING, vExtensions) Then GoTo Finally
677 End If
679 Try:
680 ' Search an individual folder
682 sFolder = oPackage.getPackageLocation(Extension)
684 Finally:
685 ExtensionFolder = SF_FileSystem._ConvertFromUrl(sFolder)
686 SF_Utils._ExitFunction(cstThisSub)
687 Exit Function
688 Catch:
689 GoTo Finally
690 End Function ' ScriptForge.SF_FileSystem.ExtensionFolder
692 REM -----------------------------------------------------------------------------
693 Public Function FileExists(Optional ByVal FileName As Variant) As Boolean
694 ''' Return True if the given file exists
695 ''' Args:
696 ''' FileName: a string representing a file
697 ''' Returns:
698 ''' True if FileName is a valid File name and it exists
699 ''' False otherwise including when FileName is a folder
700 ''' Example:
704 Dim bExists As Boolean ' Return value
705 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
710 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
711 bExists = False
713 Check:
714 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
716 End If
717 FileName = SF_FileSystem._ConvertToUrl(FileName)
719 Try:
721 bExists = oSfa.exists(FileName) And Not oSfa.isFolder(FileName)
723 Finally:
724 FileExists = bExists
725 SF_Utils._ExitFunction(cstThisSub)
726 Exit Function
727 Catch:
728 GoTo Finally
729 End Function ' ScriptForge.SF_FileSystem.FileExists
731 REM -----------------------------------------------------------------------------
732 Public Function Files(Optional ByVal FolderName As Variant _
733 , Optional ByVal Filter As Variant _
734 ) As Variant
735 ''' Return an array of the FileNames stored in the given folder. The folder must exist
736 ''' Args:
737 ''' FolderName: the folder to explore
738 ''' Filter: contains wildcards ("?" and "*") to limit the list to the relevant files (default = "")
739 ''' Returns:
740 ''' An array of strings, each entry is the FileName of an existing file
741 ''' Exceptions:
742 ''' UNKNOWNFOLDERERROR Folder does not exist
743 ''' NOTAFOLDERERROR FolderName is a file, not a folder
744 ''' Example:
745 ''' Dim a As Variant
749 Dim vFiles As Variant ' Return value
750 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
751 Dim sFolderName As String ' URL lias for FolderName
752 Dim sFile As String ' Single file
753 Dim i As Long
758 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
759 vFiles = Array()
761 Check:
762 If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = ""
763 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
766 End If
767 sFolderName = SF_FileSystem._ConvertToUrl(FolderName)
768 If SF_FileSystem.FileExists(FolderName) Then GoTo CatchFile ' Must not be a file
769 If Not SF_FileSystem.FolderExists(FolderName) Then GoTo CatchFolder ' Folder must exist
771 Try:
772 ' Get files
774 vFiles = oSfa.getFolderContents(sFolderName, False)
775 ' Adjust notations
776 For i = 0 To UBound(vFiles)
777 sFile = SF_FileSystem._ConvertFromUrl(vFiles(i))
778 vFiles(i) = sFile
779 Next i
780 ' Reduce list to those passing the filter
782 For i = 0 To UBound(vFiles)
783 sFile = SF_FileSystem.GetName(vFiles(i))
784 If Not SF_String.IsLike(sFile, Filter) Then vFiles(i) = ""
785 Next i
786 vFiles = Sf_Array.TrimArray(vFiles)
787 End If
789 Finally:
790 Files = vFiles
791 SF_Utils._ExitFunction(cstThisSub)
792 Exit Function
793 Catch:
794 GoTo Finally
795 CatchFile:
797 GoTo Finally
798 CatchFolder:
800 GoTo Finally
801 End Function ' ScriptForge.SF_FileSystem.Files
803 REM -----------------------------------------------------------------------------
804 Public Function FolderExists(Optional ByVal FolderName As Variant) As Boolean
805 ''' Return True if the given folder name exists
806 ''' Args:
807 ''' FolderName: a string representing a folder
808 ''' Returns:
809 ''' True if FolderName is a valid folder name and it exists
810 ''' False otherwise including when FolderName is a file
811 ''' Example:
815 Dim bExists As Boolean ' Return value
816 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
821 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
822 bExists = False
824 Check:
825 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
827 End If
828 FolderName = SF_FileSystem._ConvertToUrl(FolderName)
830 Try:
832 bExists = oSfa.isFolder(FolderName)
834 Finally:
835 FolderExists = bExists
836 SF_Utils._ExitFunction(cstThisSub)
837 Exit Function
838 Catch:
839 GoTo Finally
840 End Function ' ScriptForge.SF_FileSystem.FolderExists
842 REM -----------------------------------------------------------------------------
843 Public Function GetBaseName(Optional ByVal FileName As Variant) As String
844 ''' Returns the BaseName part of the last component of a File- or FolderName, without its extension
845 ''' The method does not check for the existence of the specified file or folder
846 ''' Args:
847 ''' FileName: Path and file name
848 ''' Returns:
849 ''' The BaseName of the given argument in native operating system format. May be empty
850 ''' Example:
851 ''' Dim a As String
855 Dim sBase As String ' Return value
856 Dim sExt As String ' Extension
857 Dim sName As String ' Last component of FileName
858 Dim vName As Variant ' Array of trunks of sName
862 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
863 sBase = ""
865 Check:
866 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
868 End If
870 Try:
871 sName = SF_FileSystem.GetName(FileName)
875 sExt = vName(UBound(vName))
876 sBase = Left(sName, Len(sName) - Len(sExt) - 1)
877 Else
878 sBase = sName
879 End If
880 End If
882 Finally:
883 GetBaseName = sBase
884 SF_Utils._ExitFunction(cstThisSub)
885 Exit Function
886 Catch:
887 GoTo Finally
888 End Function ' ScriptForge.SF_FileSystem.GetBaseName
890 REM -----------------------------------------------------------------------------
891 Public Function GetExtension(Optional ByVal FileName As Variant) As String
892 ''' Returns the extension part of a File- or FolderName, without the dot (.).
893 ''' The method does not check for the existence of the specified file or folder
894 ''' Args:
895 ''' FileName: Path and file name
896 ''' Returns:
897 ''' The extension without a leading dot. May be empty
898 ''' Example:
899 ''' Dim a As String
903 Dim sExt As String ' Return value
904 Dim sName As String ' Last component of FileName
905 Dim vName As Variant ' Array of trunks of sName
909 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
910 sExt = ""
912 Check:
913 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
915 End If
917 Try:
918 sName = SF_FileSystem.GetName(FileName)
921 sExt = vName(UBound(vName))
922 End If
924 Finally:
925 GetExtension = sExt
926 SF_Utils._ExitFunction(cstThisSub)
927 Exit Function
928 Catch:
929 GoTo Finally
930 End Function ' ScriptForge.SF_FileSystem.GetExtension
932 REM -----------------------------------------------------------------------------
933 Public Function GetFileLen(Optional ByVal FileName As Variant) As Currency
935 ''' Args:
936 ''' FileName: a string representing a file
937 ''' Returns:
938 ''' File size if FileName exists
939 ''' Exceptions:
940 ''' UNKNOWNFILEERROR The file does not exist of is a folder
941 ''' Example:
944 Dim curSize As Currency ' Return value
949 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
950 curSize = 0
952 Check:
953 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
955 End If
957 Try:
958 If SF_FileSystem.FileExists(FileName) Then
959 With ScriptForge.SF_Session
960 curSize = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _
961 , _ConvertFromUrl(FileName))
962 End With
963 Else
964 GoTo CatchNotExists
965 End If
967 Finally:
968 GetFileLen = curSize
969 SF_Utils._ExitFunction(cstThisSub)
970 Exit Function
971 Catch:
972 GoTo Finally
973 CatchNotExists:
975 GoTo Finally
976 End Function ' ScriptForge.SF_FileSystem.GetFileLen
978 REM -----------------------------------------------------------------------------
979 Public Function GetFileModified(Optional ByVal FileName As Variant) As Variant
980 ''' Returns the last modified date for the given file
981 ''' Args:
982 ''' FileName: a string representing an existing file
983 ''' Returns:
984 ''' The modification date and time as a Basic Date
985 ''' Exceptions:
986 ''' UNKNOWNFILEERROR The file does not exist of is a folder
987 ''' Example:
988 ''' Dim a As Date
992 Dim dModified As Date ' Return value
993 Dim oModified As New com.sun.star.util.DateTime
994 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
999 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1000 dModified = 0
1002 Check:
1003 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1005 End If
1007 Try:
1009 If SF_FileSystem.FileExists(FileName) Then
1010 FileName = SF_FileSystem._ConvertToUrl(FileName)
1011 Set oModified = oSfa.getDateTimeModified(FileName)
1012 dModified = CDateFromUnoDateTime(oModified)
1013 Else
1014 GoTo CatchNotExists
1015 End If
1017 Finally:
1018 GetFileModified = dModified
1019 SF_Utils._ExitFunction(cstThisSub)
1020 Exit Function
1021 Catch:
1022 GoTo Finally
1023 CatchNotExists:
1025 GoTo Finally
1026 End Function ' ScriptForge.SF_FileSystem.GetFileModified
1028 REM -----------------------------------------------------------------------------
1029 Public Function GetName(Optional ByVal FileName As Variant) As String
1030 ''' Returns the last component of a File- or FolderName
1031 ''' The method does not check for the existence of the specified file or folder
1032 ''' Args:
1033 ''' FileName: Path and file name
1034 ''' Returns:
1035 ''' The last component of the full file name in native operating system format
1036 ''' Example:
1037 ''' Dim a As String
1041 Dim sName As String ' Return value
1042 Dim vFile As Variant ' Array of components
1046 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1047 sName = ""
1049 Check:
1050 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1052 End If
1053 FileName = SF_FileSystem._ConvertToUrl(FileName)
1055 Try:
1059 sName = ConvertFromUrl(vFile(UBound(vFile))) ' Always in SYS format
1060 End If
1062 Finally:
1063 GetName = sName
1064 SF_Utils._ExitFunction(cstThisSub)
1065 Exit Function
1066 Catch:
1067 GoTo Finally
1068 End Function ' ScriptForge.SF_FileSystem.GetName
1070 REM -----------------------------------------------------------------------------
1071 Public Function GetParentFolderName(Optional ByVal FileName As Variant) As String
1072 ''' Returns a string containing the name of the parent folder of the last component in a specified File- or FolderName
1073 ''' The method does not check for the existence of the specified file or folder
1074 ''' Args:
1075 ''' FileName: Path and file name
1076 ''' Returns:
1077 ''' A FolderName including its final path separator
1078 ''' Example:
1079 ''' Dim a As String
1081 ''' a = FSO.GetParentFolderName("C:\Windows\Notepad.exe") returns C:\Windows\
1083 Dim sFolder As String ' Return value
1084 Dim sName As String ' Last component of FileName
1085 Dim vFile As Variant ' Array of file components
1089 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1090 sFolder = ""
1092 Check:
1093 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1095 End If
1096 FileName = SF_FileSystem._ConvertToUrl(FileName)
1098 Try:
1103 If sFolder = "" Or Right(sFolder, 1) <> "/" Then sFolder = sFolder & "/"
1105 Finally:
1106 GetParentFolderName = SF_FileSystem._ConvertFromUrl(sFolder)
1107 SF_Utils._ExitFunction(cstThisSub)
1108 Exit Function
1109 Catch:
1110 GoTo Finally
1111 End Function ' ScriptForge.SF_FileSystem.GetParentFolderName
1113 REM -----------------------------------------------------------------------------
1114 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
1115 ''' Return the actual value of the given property
1116 ''' Args:
1117 ''' PropertyName: the name of the property as a string
1118 ''' Returns:
1119 ''' The actual value of the property
1120 ''' Exceptions
1121 ''' ARGUMENTERROR The property does not exist
1126 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1127 GetProperty = Null
1129 Check:
1130 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1131 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
1132 End If
1134 Try:
1135 Select Case UCase(PropertyName)
1144 Case Else
1145 End Select
1147 Finally:
1148 SF_Utils._ExitFunction(cstThisSub)
1149 Exit Function
1150 Catch:
1151 GoTo Finally
1152 End Function ' ScriptForge.SF_FileSystem.GetProperty
1154 REM -----------------------------------------------------------------------------
1155 Public Function GetTempName() As String
1156 ''' Returns a randomly generated temporary file name that is useful for performing
1157 ''' operations that require a temporary file : the method does not create any file
1158 ''' Args:
1159 ''' Returns:
1160 ''' A FileName as a String that can be used f.i. with CreateTextFile()
1161 ''' The FileName does not have any suffix
1162 ''' Example:
1163 ''' Dim a As String
1167 Dim sFile As String ' Return value
1168 Dim sTempDir As String ' The path to a temporary folder
1169 Dim lRandom As Long ' Random integer
1172 Const cstSubArgs = ""
1174 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1175 sFile = ""
1177 Check:
1178 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
1180 Try:
1182 sFile = SF_FileSystem.TemporaryFolder & "SF_" & Right("000000" & lRandom, 6)
1184 Finally:
1185 GetTempName = SF_FileSystem._ConvertFromUrl(sFile)
1186 SF_Utils._ExitFunction(cstThisSub)
1187 Exit Function
1188 Catch:
1189 GoTo Finally
1190 End Function ' ScriptForge.SF_FileSystem.GetTempName
1192 REM -----------------------------------------------------------------------------
1193 Public Function HashFile(Optional ByVal FileName As Variant _
1194 , Optional ByVal Algorithm As Variant _
1195 ) As String
1196 ''' Return an hexadecimal string representing a checksum of the given file
1197 ''' Next algorithms are supported: MD5, SHA1, SHA224, SHA256, SHA384 and SHA512
1198 ''' Args:
1199 ''' FileName: a string representing a file
1200 ''' Algorithm: The hashing algorithm to use
1201 ''' Returns:
1202 ''' The requested checksum as a string. Hexadecimal digits are lower-cased
1203 ''' A zero-length string when an error occurred
1204 ''' Exceptions:
1205 ''' UNKNOWNFILEERROR The file does not exist of is a folder
1206 ''' Example:
1209 Dim sHash As String ' Return value
1212 Const cstSubArgs = "FileName, Algorithm=""MD5""|""SHA1""|""SHA224""|""SHA256""|""SHA384""|""SHA512"""
1214 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1215 sHash = ""
1217 Check:
1218 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1221 , Array("MD5", "SHA1", "SHA224", "SHA256", "SHA384", "SHA512")) Then GoTo Finally
1222 End If
1224 Try:
1225 If SF_FileSystem.FileExists(FileName) Then
1226 With ScriptForge.SF_Session
1227 sHash = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _
1228 , _ConvertFromUrl(FileName), LCase(Algorithm))
1229 End With
1230 Else
1231 GoTo CatchNotExists
1232 End If
1234 Finally:
1235 HashFile = sHash
1236 SF_Utils._ExitFunction(cstThisSub)
1237 Exit Function
1238 Catch:
1239 GoTo Finally
1240 CatchNotExists:
1242 GoTo Finally
1243 End Function ' ScriptForge.SF_FileSystem.HashFile
1245 REM -----------------------------------------------------------------------------
1246 Public Function Methods() As Variant
1247 ''' Return the list or methods of the FileSystem service as an array
1276 )
1278 End Function ' ScriptForge.SF_FileSystem.Methods
1280 REM -----------------------------------------------------------------------------
1281 Public Function MoveFile(Optional ByVal Source As Variant _
1282 , Optional ByVal Destination As Variant _
1283 ) As Boolean
1284 ''' Moves one or more files from one location to another
1285 ''' Args:
1286 ''' Source: FileName or NamePattern which can include wildcard characters, for one or more files to be moved
1287 ''' Destination: FileName where the single Source file is to be moved
1288 ''' If Source and Destination have the same parent folder MoveFile amounts to renaming the Source
1289 ''' or FolderName where the multiple files from Source are to be moved
1290 ''' If FolderName does not exist, it is created
1291 ''' Anyway, wildcard characters are not allowed in Destination
1292 ''' Returns:
1293 ''' True if at least one file has been moved
1294 ''' False if an error occurred
1295 ''' An error also occurs if a source using wildcard characters doesn't match any files.
1296 ''' The method stops on the first error it encounters
1297 ''' No attempt is made to roll back or undo any changes made before an error occurs
1298 ''' Exceptions:
1299 ''' UNKNOWNFILEERROR Source does not exist
1300 ''' UNKNOWNFOLDERERROR Source folder or Destination folder does not exist
1301 ''' NOFILEMATCHERROR No file matches Source containing wildcards
1302 ''' NOTAFOLDERERROR Destination is a file, not a folder
1303 ''' NOTAFILEERROR Destination is a folder, not a file
1304 ''' OVERWRITEERROR Destination can not be overwritten
1305 ''' Example:
1307 ''' FSO.MoveFile("C:\Temp1\*.*", "C:\Temp2\") ' Only files are moved, subfolders are not
1309 Dim bMove As Boolean ' Return value
1314 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1315 bMove = False
1317 Check:
1318 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1321 End If
1323 Try:
1326 Finally:
1327 MoveFile = bMove
1328 SF_Utils._ExitFunction(cstThisSub)
1329 Exit Function
1330 Catch:
1331 GoTo Finally
1332 End Function ' ScriptForge.SF_FileSystem.MoveFile
1334 REM -----------------------------------------------------------------------------
1335 Public Function MoveFolder(Optional ByVal Source As Variant _
1336 , Optional ByVal Destination As Variant _
1337 ) As Boolean
1338 ''' Moves one or more folders from one location to another
1339 ''' Args:
1340 ''' Source: FolderName or NamePattern which can include wildcard characters, for one or more folders to be moved
1341 ''' Destination: FolderName where the single Source folder is to be moved
1342 ''' FolderName must not exist
1343 ''' or FolderName where the multiple folders from Source are to be moved
1344 ''' If FolderName does not exist, it is created
1345 ''' Anyway, wildcard characters are not allowed in Destination
1346 ''' Returns:
1347 ''' True if at least one folder has been moved
1348 ''' False if an error occurred
1349 ''' An error also occurs if a source using wildcard characters doesn't match any folders.
1350 ''' The method stops on the first error it encounters
1351 ''' No attempt is made to roll back or undo any changes made before an error occurs
1352 ''' Exceptions:
1353 ''' UNKNOWNFILEERROR Source does not exist
1354 ''' UNKNOWNFOLDERERROR Source folder or Destination folder does not exist
1355 ''' NOFILEMATCHERROR No file matches Source containing wildcards
1356 ''' NOTAFOLDERERROR Destination is a file, not a folder
1357 ''' OVERWRITEERROR Destination can not be overwritten
1358 ''' Example:
1362 Dim bMove As Boolean ' Return value
1367 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1368 bMove = False
1370 Check:
1371 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1374 End If
1376 Try:
1379 Finally:
1380 MoveFolder = bMove
1381 SF_Utils._ExitFunction(cstThisSub)
1382 Exit Function
1383 Catch:
1384 GoTo Finally
1385 End Function ' ScriptForge.SF_FileSystem.MoveFolder
1387 REM -----------------------------------------------------------------------------
1388 Public Function Normalize(Optional ByVal FileName As Variant) As String
1389 ''' Normalize a pathname by collapsing redundant separators and up-level references
1390 ''' so that A//B, A/B/, A/./B and A/foo/../B all become A/B.
1391 ''' On Windows, it converts forward slashes to backward slashes.
1392 ''' Args:
1393 ''' FileName: a string representing a file. The file may not exist.
1394 ''' Returns:
1395 ''' The normalized filename in filenaming notation
1396 ''' Example:
1397 ''' Print SF_FileSystem.Normalize("A/foo/../B/C/./D//E") ' A/B/C/D/E
1399 Dim sNorm As String ' Return value
1404 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1405 sNorm = ""
1407 Check:
1408 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1410 End If
1412 Try:
1413 With ScriptForge.SF_Session
1414 sNorm = .ExecutePythonScript(.SCRIPTISSHARED, _SF_.PythonHelper & cstPyHelper _
1415 , _ConvertFromUrl(FileName))
1416 ' The Python os.path expects and returns a file name in os notation
1418 End With
1420 Finally:
1421 Normalize = sNorm
1422 SF_Utils._ExitFunction(cstThisSub)
1423 Exit Function
1424 Catch:
1425 GoTo Finally
1426 End Function ' ScriptForge.SF_FileSystem.Normalize
1428 REM -----------------------------------------------------------------------------
1429 Public Function OpenTextFile(Optional ByVal FileName As Variant _
1430 , Optional ByVal IOMode As Variant _
1431 , Optional ByVal Create As Variant _
1432 , Optional ByVal Encoding As Variant _
1433 ) As Object
1434 ''' Opens a specified file and returns a TextStream object that can be used to read from, write to, or append to the file
1435 ''' Args:
1436 ''' FileName: Identifies the file to open
1437 ''' IOMode: Indicates input/output mode. Can be one of three constants: ForReading, ForWriting, or ForAppending
1438 ''' Create: Boolean value that indicates whether a new file can be created if the specified filename doesn't exist.
1439 ''' The value is True if a new file and its parent folders may be created; False if they aren't created (default)
1440 ''' Encoding: The character set that should be used
1441 ''' Use one of the Names listed in https://www.iana.org/assignments/character-sets/character-sets.xhtml
1442 ''' Note that LibreOffice does not implement all existing sets
1444 ''' Returns:
1445 ''' An instance of the SF_TextStream class representing the opened file or a Null object if an error occurred
1446 ''' The method does not check if the file is really a text file
1447 ''' It doesn't check either if the given encoding is implemented in LibreOffice nor if it is the right one
1448 ''' Exceptions:
1449 ''' UNKNOWNFILEERROR File does not exist
1450 ''' Example:
1451 ''' Dim myFile As Object
1453 ''' Set myFile = FSO.OpenTextFile("C:\Temp\ThisFile.txt", FSO.ForReading)
1456 Dim oTextStream As Object ' Return value
1457 Dim bExists As Boolean ' File to open does exist
1459 Const cstSubArgs = "FileName, [IOMode=1], [Create=False], [Encoding=""UTF-8""]"
1461 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1462 Set oTextStream = Nothing
1464 Check:
1465 With SF_FileSystem
1466 If IsMissing(IOMode) Or IsEmpty(IOMode) Then IOMode = ForReading
1467 If IsMissing(Create) Or IsEmpty(Create) Then Create = False
1469 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1472 , Array(ForReading, ForWriting, ForAppending)) _
1473 Then GoTo Finally
1476 End If
1478 bExists = .FileExists(FileName)
1479 Select Case IOMode
1480 Case ForReading : If Not bExists Then GoTo CatchNotExists
1481 Case Else : If Not bExists And Not Create Then GoTo CatchNotExists
1482 End Select
1484 If IOMode = ForAppending And Not bExists Then IOMode = ForWriting
1485 End With
1487 Try:
1488 ' Create and initialize TextStream class instance
1489 Set oTextStream = New SF_TextStream
1490 With oTextStream
1491 .[Me] = oTextStream
1492 .[_Parent] = SF_FileSystem
1493 ._FileName = SF_FileSystem._ConvertToUrl(FileName)
1494 ._IOMode = IOMode
1495 ._Encoding = Encoding
1496 ._FileExists = bExists
1497 ._Initialize()
1498 End With
1500 Finally:
1501 Set OpenTextFile = oTextStream
1502 SF_Utils._ExitFunction(cstThisSub)
1503 Exit Function
1504 Catch:
1505 GoTo Finally
1506 CatchNotExists:
1508 GoTo Finally
1509 End Function ' ScriptForge.SF_FileSystem.OpenTextFile
1511 REM -----------------------------------------------------------------------------
1512 Public Function PickFile(Optional ByVal DefaultFile As Variant _
1513 , Optional ByVal Mode As Variant _
1514 , Optional ByVal Filter As Variant _
1515 ) As String
1516 ''' Returns the file selected with a FilePicker dialog box
1517 ''' The mode, OPEN or SAVE, and the filter may be preset
1518 ''' If mode = SAVE and the picked file exists, a warning message will be displayed
1520 ''' Args:
1521 ''' DefaultFile: Folder part: the FolderName from which to start. Default = the last selected folder
1522 ''' File part: the default file to open or save
1524 ''' Filter: by default only files having the given suffix will be displayed. Default = all suffixes
1525 ''' The filter combo box will contain the given SuffixFilter (if not "*") and "*.*"
1526 ''' Returns:
1527 ''' The selected FileName in URL format or "" if the dialog was cancelled
1528 ''' Example:
1530 ''' FSO.PickFile("C:\", "OPEN", "txt") ' Only *.txt files are displayed
1532 Dim oFileDialog As Object ' com.sun.star.ui.dialogs.FilePicker
1533 Dim oFileAccess As object ' com.sun.star.ucb.SimpleFileAccess
1534 Dim oPath As Object ' com.sun.star.util.PathSettings
1535 Dim iAccept As Integer ' Result of dialog execution
1536 Dim sInitPath As String ' Current working directory
1537 Dim sBaseFile As String
1538 Dim iMode As Integer ' Numeric alias for SelectMode
1539 Dim sFile As String ' Return value
1542 Const cstSubArgs = "[DefaultFile=""""], [Mode=""OPEN""|""SAVE""],[Filter=""""]"
1544 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1545 sFile = ""
1547 Check:
1548 If IsMissing(DefaultFile) Or IsEmpty(DefaultFile) Then DefaultFile = ""
1550 If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = ""
1551 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1553 If Not SF_Utils._Validate(Mode, "Mode", V_STRING, Array("OPEN", "SAVE")) Then GoTo Finally
1555 End If
1556 DefaultFile = SF_FileSystem._ConvertToUrl(DefaultFile)
1558 Try:
1559 ' Derive numeric equivalent of the Mode argument: https://api.libreoffice.org/docs/idl/ref/TemplateDescription_8idl.html
1560 With com.sun.star.ui.dialogs.TemplateDescription
1562 End With
1564 ' Activate the filepicker dialog
1566 With oFileDialog
1567 .Initialize(Array(iMode))
1569 ' Set filters
1570 If Len(Filter) > 0 Then .appendFilter("*." & Filter, "*." & Filter) ' Twice: required by API
1572 If Len(Filter) > 0 Then .setCurrentFilter("*." & Filter) Else .setCurrentFilter("*.*")
1574 ' Set initial folder
1577 sInitPath = oPath.Work ' Probably My Documents
1578 Else
1579 sInitPath = SF_FileSystem._ParseUrl(ConvertToUrl(DefaultFile)).Path
1580 End If
1582 ' Set default values
1584 If oFileAccess.exists(sInitPath) Then .SetDisplayDirectory(sInitPath)
1585 sBaseFile = SF_FileSystem.GetName(DefaultFile)
1586 .setDefaultName(sBaseFile)
1588 ' Get selected file
1589 iAccept = .Execute()
1590 If iAccept = com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then sFile = .getSelectedFiles()(0)
1593 .dispose()
1594 End With
1596 Finally:
1597 PickFile = SF_FileSystem._ConvertFromUrl(sFile)
1598 SF_Utils._ExitFunction(cstThisSub)
1599 Exit Function
1600 Catch:
1601 GoTo Finally
1602 End Function ' ScriptForge.SF_FileSystem.PickFile
1604 REM -----------------------------------------------------------------------------
1605 Public Function PickFolder(Optional ByVal DefaultFolder As Variant _
1606 , Optional ByVal FreeText As Variant _
1607 ) As String
1608 ''' Display a FolderPicker dialog box
1609 ''' Args:
1610 ''' DefaultFolder: the FolderName from which to start. Default = the last selected folder
1612 ''' Returns:
1613 ''' The selected FolderName in URL or operating system format
1614 ''' The zero-length string if the dialog was cancelled
1615 ''' Example:
1617 ''' FSO.PickFolder("C:\", "Choose a folder or press Cancel")
1619 Dim oFolderDialog As Object ' com.sun.star.ui.dialogs.FolderPicker
1620 Dim iAccept As Integer ' Value returned by the dialog (OK, Cancel, ..)
1624 Const cstSubArgs = "[DefaultFolder=""""], [FreeText=""""]"
1626 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1627 sFolder = ""
1629 Check:
1630 If IsMissing(DefaultFolder) Or IsEmpty(DefaultFolder) Then DefaultFolder = ""
1631 If IsMissing(FreeText) Or IsEmpty(FreeText) Then FreeText = ""
1632 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1633 If Not SF_Utils._ValidateFile(DefaultFolder, "DefaultFolder", , True) Then GoTo Finally
1635 End If
1636 DefaultFolder = SF_FileSystem._ConvertToUrl(DefaultFolder)
1638 Try:
1640 If Not IsNull(oFolderDialog) Then
1641 With oFolderDialog
1643 .Description = FreeText
1644 iAccept = .Execute()
1645 ' https://api.libreoffice.org/docs/idl/ref/ExecutableDialogResults_8idl.html
1646 If iAccept = com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then
1647 .DisplayDirectory = .Directory ' Set the next default initial folder to the selected one
1649 End If
1650 End With
1651 End If
1653 Finally:
1654 PickFolder = SF_FileSystem._ConvertFromUrl(sFolder)
1655 SF_Utils._ExitFunction(cstThisSub)
1656 Exit Function
1657 Catch:
1658 GoTo Finally
1659 End Function ' ScriptForge.SF_FileSystem.PickFolder
1661 REM -----------------------------------------------------------------------------
1662 Public Function Properties() As Variant
1663 ''' Return the list or properties of the FileSystem module as an array
1665 Properties = Array( _
1674 )
1676 End Function ' ScriptForge.SF_FileSystem.Properties
1678 REM -----------------------------------------------------------------------------
1679 Public Function SetProperty(Optional ByVal PropertyName As Variant _
1680 , Optional ByRef Value As Variant _
1681 ) As Boolean
1682 ''' Set a new value to the given property
1683 ''' Args:
1684 ''' PropertyName: the name of the property as a string
1685 ''' Value: its new value
1686 ''' Exceptions
1687 ''' ARGUMENTERROR The property does not exist
1692 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1693 SetProperty = False
1695 Check:
1696 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1697 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
1698 End If
1700 Try:
1701 Select Case UCase(PropertyName)
1703 Case Else
1704 End Select
1706 Finally:
1707 SF_Utils._ExitFunction(cstThisSub)
1708 Exit Function
1709 Catch:
1710 GoTo Finally
1711 End Function ' ScriptForge.SF_FileSystem.SetProperty
1713 REM -----------------------------------------------------------------------------
1714 Public Function SubFolders(Optional ByVal FolderName As Variant _
1715 , Optional ByVal Filter As Variant _
1716 ) As Variant
1717 ''' Return an array of the FolderNames stored in the given folder. The folder must exist
1718 ''' Args:
1719 ''' FolderName: the folder to explore
1720 ''' Filter: contains wildcards ("?" and "*") to limit the list to the relevant folders (default = "")
1721 ''' Returns:
1722 ''' An array of strings, each entry is the FolderName of an existing folder
1723 ''' Exceptions:
1724 ''' UNKNOWNFOLDERERROR Folder does not exist
1725 ''' NOTAFOLDERERROR FolderName is a file, not a folder
1726 ''' Example:
1727 ''' Dim a As Variant
1731 Dim vSubFolders As Variant ' Return value
1732 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
1733 Dim sFolderName As String ' URL lias for FolderName
1734 Dim sFolder As String ' Single folder
1735 Dim i As Long
1740 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1741 vSubFolders = Array()
1743 Check:
1744 If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = ""
1745 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1748 End If
1749 sFolderName = SF_FileSystem._ConvertToUrl(FolderName)
1750 If SF_FileSystem.FileExists(FolderName) Then GoTo CatchFile ' Must not be a file
1751 If Not SF_FileSystem.FolderExists(FolderName) Then GoTo CatchFolder ' Folder must exist
1753 Try:
1754 ' Get SubFolders
1756 vSubFolders = oSfa.getFolderContents(sFolderName, True)
1757 ' List includes files; remove them or adjust notations of folders
1758 For i = 0 To UBound(vSubFolders)
1760 If SF_FileSystem.FileExists(sFolder) Then vSubFolders(i) = "" Else vSubFolders(i) = sFolder
1761 ' Reduce list to those passing the filter
1763 sFolder = SF_FileSystem.GetName(vSubFolders(i))
1764 If Not SF_String.IsLike(sFolder, Filter) Then vSubFolders(i) = ""
1765 End If
1766 Next i
1767 vSubFolders = SF_Array.TrimArray(vSubFolders)
1769 Finally:
1770 SubFolders = vSubFolders
1771 SF_Utils._ExitFunction(cstThisSub)
1772 Exit Function
1773 Catch:
1774 GoTo Finally
1775 CatchFile:
1777 GoTo Finally
1778 CatchFolder:
1780 GoTo Finally
1781 End Function ' ScriptForge.SF_FileSystem.SubFolders
1783 REM =========================================================== PRIVATE FUNCTIONS
1785 REM -----------------------------------------------------------------------------
1786 Private Function _ConvertFromUrl(psFile) As String
1787 ''' Execute the builtin ConvertFromUrl function only when relevant
1788 ''' i.e. when FileNaming (how arguments and return values are provided) = "SYS"
1789 ''' Called at the bottom of methods returning file names
1790 ''' Remark: psFile might contain wildcards
1792 Const cstQuestion = "$QUESTION$", cstStar = "$STAR$" ' Special tokens to replace wildcards
1795 _ConvertFromUrl = Replace(Replace( _
1798 Else
1799 _ConvertFromUrl = psFile
1800 End If
1802 End Function ' ScriptForge.FileSystem._ConvertFromUrl
1804 REM -----------------------------------------------------------------------------
1805 Private Function _ConvertToUrl(psFile) As String
1806 ''' Execute the builtin ConvertToUrl function only when relevant
1807 ''' i.e. when FileNaming (how arguments and return values are provided) <> "URL"
1808 ''' Called at the top of methods receiving file names as arguments
1809 ''' Remark: psFile might contain wildcards
1812 _ConvertToUrl = psFile
1813 Else
1816 End If
1818 End Function ' ScriptForge.FileSystem._ConvertToUrl
1820 REM -----------------------------------------------------------------------------
1821 Private Function _CopyMove(psMethod As String _
1822 , psSource As String _
1823 , psDestination As String _
1824 , pbOverWrite As Boolean _
1825 ) As Boolean
1826 ''' Checks the arguments and executes the given method
1827 ''' Args:
1828 ''' psMethod: CopyFile/CopyFolder or MoveFile/MoveFolder
1829 ''' psSource: Either File/FolderName
1830 ''' or NamePattern which can include wildcard characters, for one or more files/folders to be copied
1831 ''' psDestination: FileName or FolderName for copy/move of a single file/folder
1832 ''' Otherwise a destination FolderName. If it does not exist, it is created
1833 ''' pbOverWrite: If True, files/folders may be overwritten
1834 ''' Must be False for Move operations
1835 ''' Next checks are done:
1836 ''' With wildcards (multiple files/folders):
1837 ''' - Parent folder of source must exist
1838 ''' - Destination must not be a file
1839 ''' - Parent folder of Destination must exist
1840 ''' - If the Destination folder does not exist a new folder is created,
1841 ''' - At least one file matches the wildcards expression
1842 ''' - Destination files/folder must not exist if pbOverWrite = False
1843 ''' - Destination files/folders must not have the read-only attribute set
1844 ''' - Destination files must not be folders, destination folders must not be files
1845 ''' Without wildcards (single file/folder):
1846 ''' - Source file/folder must exist and be a file/folder
1847 ''' - Parent folder of Destination must exist
1848 ''' - Destination must not be an existing folder/file
1849 ''' - Destination file/folder must not exist if pbOverWrite = False
1850 ''' - Destination file must not have the read-only attribute set
1852 Dim bCopyMove As Boolean ' Return value
1853 Dim bCopy As Boolean ' True if Copy, False if Move
1854 Dim bFile As Boolean ' True if File, False if Folder
1855 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
1856 Dim bWildCards As Boolean ' True if wildcards found in Source
1857 Dim bCreateFolder As Boolean ' True when the destination folder should be created
1858 Dim bDestExists As Boolean ' True if destination exists
1859 Dim sSourceUrl As String ' Alias for Source
1860 Dim sDestinationUrl As String ' Alias for Destination
1861 Dim sDestinationFile As String ' Destination FileName
1862 Dim sParentFolder As String ' Parent folder of Source
1863 Dim vFiles As Variant ' Array of candidates for copy/move
1864 Dim sFile As String ' Single file/folder
1865 Dim sName As String ' Name (last component) of file
1866 Dim i As Long
1868 ' Error handling left to calling routine
1869 bCopyMove = False
1872 bWildCards = ( InStr(psSource, "*") + InStr(psSource, "?") + InStr(psSource, "%3F") > 0 ) 'ConvertToUrl() converts sometimes "?" to "%3F"
1873 bDestExists = False
1875 With SF_FileSystem
1877 Check:
1878 If bWildCards Then
1879 sParentFolder = .GetParentFolderName(psSource)
1880 If Not .FolderExists(sParentFolder) Then GoTo CatchNoMatch
1881 If .FileExists(psDestination) Then GoTo CatchFileNotFolder
1882 If Not .FolderExists(.GetParentFolderName(psDestination)) Then GoTo CatchDestFolderNotExists
1883 bCreateFolder = Not .FolderExists(psDestination)
1884 Else
1885 Select Case bFile
1886 Case True ' File
1887 If Not .FileExists(psSource) Then GoTo CatchFileNotExists
1888 If Not .FolderExists(.GetParentFolderName(psDestination)) Then GoTo CatchSourceFolderNotExists
1889 If .FolderExists(psDestination) Then GoTo CatchFolderNotFile
1890 bDestExists = .FileExists(psDestination)
1891 If pbOverWrite = False And bDestExists = True Then GoTo CatchDestinationExists
1892 bCreateFolder = False
1893 Case False ' Folder
1894 If Not .FolderExists(psSource) Then GoTo CatchSourceFolderNotExists
1895 If Not .FolderExists(.GetParentFolderName(psDestination)) Then GoTo CatchDestFolderNotExists
1896 If .FileExists(psDestination) Then GoTo CatchFileNotFolder
1897 bDestExists = .FolderExists(psDestination)
1898 If pbOverWrite = False And bDestExists Then GoTo CatchDestinationExists
1899 bCreateFolder = Not bDestExists
1900 End Select
1901 End If
1903 Try:
1905 If bWildCards Then
1906 If bFile Then vFiles = .Files(sParentFolder, .GetName(psSource)) Else vFiles = .SubFolders(sParentFolder, .GetName(psSource))
1908 ' Go through the candidates
1909 If bCreateFolder Then .CreateFolder(psDestination)
1910 For i = 0 To UBound(vFiles)
1911 sFile = vFiles(i)
1912 sDestinationFile = .BuildPath(psDestination, .GetName(sFile))
1913 If bFile Then bDestExists = .FileExists(sDestinationFile) Else bDestExists = .FolderExists(sDestinationFile)
1914 If pbOverWrite = False Then
1915 If bDestExists Then GoTo CatchDestinationExists
1916 If .FolderExists(sDestinationFile) Then GoTo CatchDestinationExists
1917 End If
1918 sSourceUrl = ._ConvertToUrl(sFile)
1919 sDestinationUrl = ._ConvertToUrl(sDestinationFile)
1920 If bDestExists Then
1921 If oSfa.isReadOnly(sDestinationUrl) Then GoTo CatchDestinationReadOnly
1922 End If
1923 Select Case bCopy
1924 Case True : oSfa.copy(sSourceUrl, sDestinationUrl)
1925 Case False : oSfa.move(sSourceUrl, sDestinationUrl)
1926 End Select
1927 Next i
1928 Else
1929 sSourceUrl = ._ConvertToUrl(psSource)
1930 sDestinationUrl = ._ConvertToUrl(psDestination)
1931 If bDestExists Then
1932 If oSfa.isReadOnly(sDestinationUrl) Then GoTo CatchDestinationReadOnly
1933 End If
1934 If bCreateFolder Then .CreateFolder(psDestination)
1935 Select Case bCopy
1936 Case True : oSfa.copy(sSourceUrl, sDestinationUrl)
1937 Case False : oSfa.move(sSourceUrl, sDestinationUrl)
1938 End Select
1939 End If
1941 End With
1943 bCopyMove = True
1945 Finally:
1946 _CopyMove = bCopyMove
1947 Exit Function
1948 CatchFileNotExists:
1950 GoTo Finally
1951 CatchSourceFolderNotExists:
1953 GoTo Finally
1954 CatchDestFolderNotExists:
1956 GoTo Finally
1957 CatchFolderNotFile:
1959 GoTo Finally
1960 CatchDestinationExists:
1962 GoTo Finally
1963 CatchNoMatch:
1965 GoTo Finally
1966 CatchFileNotFolder:
1968 GoTo Finally
1969 CatchDestinationReadOnly:
1970 SF_Exception.RaiseFatal(READONLYERROR, "Destination", Iif(bWildCards, sDestinationFile, psDestination))
1971 GoTo Finally
1972 End Function ' ScriptForge.SF_FileSystem._CopyMove
1974 REM -----------------------------------------------------------------------------
1975 Public Function _CountTextLines(ByVal psFileName As String _
1976 , Optional ByVal pbIncludeBlanks As Boolean _
1977 ) As Long
1978 ''' Convenient function to count the number of lines in a textfile
1979 ''' Args:
1980 ''' psFileName: the file in FileNaming notation
1981 ''' pbIncludeBlanks: if True (default), zero-length lines are included
1982 ''' Returns:
1985 Dim lLines As Long ' Return value
1986 Dim oFile As Object ' File handler
1987 Dim sLine As String ' The last line read
1989 Try:
1990 lLines = 0
1991 If IsMissing(pbIncludeBlanks) Then pbIncludeBlanks = True
1992 Set oFile = SF_FileSystem.OpenTextFile(psFileName, ForReading)
1993 With oFile
1994 If Not IsNull(oFile) Then
1995 Do While Not .AtEndOfStream
1996 sLine = .ReadLine()
1998 Loop
1999 End If
2000 .CloseFile()
2001 Set oFile = .Dispose()
2002 End With
2004 Finally:
2005 _CountTextLines = lLines
2006 Exit Function
2007 End Function ' ScriptForge.SF_FileSystem._CountTextLines
2009 REM -----------------------------------------------------------------------------
2010 Private Function _Delete(psMethod As String _
2011 , psFile As String _
2012 ) As Boolean
2013 ''' Checks the argument and executes the given psMethod
2014 ''' Args:
2015 ''' psMethod: CopyFile/CopyFolder or MoveFile/MoveFolder
2016 ''' psFile: Either File/FolderName
2017 ''' or NamePattern which can include wildcard characters, for one or more files/folders to be deleted
2018 ''' Next checks are done:
2019 ''' With wildcards (multiple files/folders):
2020 ''' - Parent folder of File must exist
2021 ''' - At least one file matches the wildcards expression
2022 ''' - Files or folders to delete must not have the read-only attribute set
2023 ''' Without wildcards (single file/folder):
2024 ''' - File/folder must exist and be a file/folder
2025 ''' - A file or folder to delete must not have the read-only attribute set
2027 Dim bDelete As Boolean ' Return value
2028 Dim bFile As Boolean ' True if File, False if Folder
2029 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
2030 Dim bWildCards As Boolean ' True if wildcards found in File
2031 Dim sFileUrl As String ' Alias for File
2032 Dim sParentFolder As String ' Parent folder of File
2033 Dim vFiles As Variant ' Array of candidates for deletion
2034 Dim sFile As String ' Single file/folder
2035 Dim sName As String ' Name (last component) of file
2036 Dim i As Long
2038 ' Error handling left to calling routine
2039 bDelete = False
2041 bWildCards = ( InStr(psFile, "*") + InStr(psFile, "?") + InStr(psFile, "%3F") > 0 ) 'ConvertToUrl() converts sometimes "?" to "%3F"
2043 With SF_FileSystem
2045 Check:
2046 If bWildCards Then
2047 sParentFolder = .GetParentFolderName(psFile)
2048 If Not .FolderExists(sParentFolder) Then GoTo CatchNoMatch
2049 Else
2050 Select Case bFile
2051 Case True ' File
2052 If .FolderExists(psFile) Then GoTo CatchFolderNotFile
2053 If Not .FileExists(psFile) Then GoTo CatchFileNotExists
2054 Case False ' Folder
2055 If .FileExists(psFile) Then GoTo CatchFileNotFolder
2056 If Not .FolderExists(psFile) Then GoTo CatchFolderNotExists
2057 End Select
2058 End If
2060 Try:
2062 If bWildCards Then
2063 If bFile Then vFiles = .Files(sParentFolder) Else vFiles = .SubFolders(sParentFolder)
2064 ' Select candidates
2065 For i = 0 To UBound(vFiles)
2066 If Not SF_String.IsLike(.GetName(vFiles(i)), .GetName(psFile)) Then vFiles(i) = ""
2067 Next i
2068 vFiles = SF_Array.TrimArray(vFiles)
2070 ' Go through the candidates
2071 For i = 0 To UBound(vFiles)
2072 sFile = vFiles(i)
2073 sFileUrl = ._ConvertToUrl(sFile)
2074 If oSfa.isReadOnly(sFileUrl) Then GoTo CatchReadOnly
2075 oSfa.kill(sFileUrl)
2076 Next i
2077 Else
2078 sFileUrl = ._ConvertToUrl(psFile)
2079 If oSfa.isReadOnly(sFileUrl) Then GoTo CatchReadOnly
2080 oSfa.kill(sFileUrl)
2081 End If
2083 End With
2085 bDelete = True
2087 Finally:
2088 _Delete = bDelete
2089 Exit Function
2090 CatchFolderNotExists:
2092 GoTo Finally
2093 CatchFileNotExists:
2095 GoTo Finally
2096 CatchFolderNotFile:
2098 GoTo Finally
2099 CatchNoMatch:
2100 SF_Exception.RaiseFatal(NOFILEMATCHERROR, Iif(bFile, "FileName", "FolderName"), psFile)
2101 GoTo Finally
2102 CatchFileNotFolder:
2104 GoTo Finally
2105 CatchReadOnly:
2106 SF_Exception.RaiseFatal(READONLYERROR, Iif(bFile, "FileName", "FolderName"), Iif(bWildCards, sFile, psFile))
2107 GoTo Finally
2108 End Function ' ScriptForge.SF_FileSystem._Delete
2110 REM -----------------------------------------------------------------------------
2111 Private Function _GetConfigFolder(ByVal psFolder As String) As String
2112 ''' Returns one of next configuration folders: see https://api.libreoffice.org/docs/idl/ref/servicecom_1_1sun_1_1star_1_1util_1_1PathSubstitution.html
2116 ''' work => The work directory of the user. Under Windows this would be the "MyDocuments" subdirectory. Under Unix this would be the home-directory
2117 ''' home => The home directory of the user. Under Unix this would be the home- directory.
2118 ''' Under Windows this would be the CSIDL_PERSONAL directory, for example "Documents and Settings\<username>\Documents"
2121 Dim oSubst As Object ' com.sun.star.util.PathSubstitution
2122 Dim sConfig As String ' Return value
2124 sConfig = ""
2126 If Not IsNull(oSubst) Then sConfig = oSubst.getSubstituteVariableValue("$(" & psFolder & ")") & "/"
2128 _GetConfigFolder = SF_FileSystem._ConvertFromUrl(sConfig)
2130 End Function ' ScriptForge.FileSystem._GetConfigFolder
2132 REM -----------------------------------------------------------------------------
2133 Public Function _ParseUrl(psUrl As String) As Object
2134 ''' Returns a com.sun.star.util.URL structure based on the argument
2136 Dim oParse As Object ' com.sun.star.util.URLTransformer
2137 Dim bParsed As Boolean ' True if parsing is successful
2138 Dim oUrl As New com.sun.star.util.URL ' Return value
2140 oUrl.Complete = psUrl
2142 bParsed = oParse.parseStrict(oUrl, "")
2143 If bParsed Then oUrl.Path = ConvertToUrl(oUrl.Path)
2145 Set _ParseUrl = oUrl
2147 End Function ' ScriptForge.SF_FileSystem._ParseUrl
2149 REM -----------------------------------------------------------------------------
2150 Public Function _SFInstallFolder() As String
2151 ''' Returns the installation folder of the ScriptForge library
2152 ''' Either:
2154 ''' ($config)/basic/ScriptForge
2156 ''' ($install)/share/basic/ScriptForge
2158 Dim sFolder As String ' Folder
2160 _SFInstallFolder = ""
2163 If Not FolderExists(sFolder) Then
2165 If Not FolderExists(sFolder) Then Exit Function
2166 End If
2168 _SFInstallFolder = _ConvertFromUrl(sFolder)
2170 End Function ' ScriptForge.SF_FileSystem._SFInstallFolder
2172 REM ============================================ END OF SCRIPTFORGE.SF_FileSystem
2173 </script:module>