| blob | b09f980429f43c7074551a5d86363e2ad262db97 |
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()
1595 End With
1597 Finally:
1598 PickFile = SF_FileSystem._ConvertFromUrl(sFile)
1599 SF_Utils._ExitFunction(cstThisSub)
1600 Exit Function
1601 Catch:
1602 GoTo Finally
1603 End Function ' ScriptForge.SF_FileSystem.PickFile
1605 REM -----------------------------------------------------------------------------
1606 Public Function PickFolder(Optional ByVal DefaultFolder As Variant _
1607 , Optional ByVal FreeText As Variant _
1608 ) As String
1609 ''' Display a FolderPicker dialog box
1610 ''' Args:
1611 ''' DefaultFolder: the FolderName from which to start. Default = the last selected folder
1613 ''' Returns:
1614 ''' The selected FolderName in URL or operating system format
1615 ''' The zero-length string if the dialog was cancelled
1616 ''' Example:
1618 ''' FSO.PickFolder("C:\", "Choose a folder or press Cancel")
1620 Dim oFolderDialog As Object ' com.sun.star.ui.dialogs.FolderPicker
1621 Dim iAccept As Integer ' Value returned by the dialog (OK, Cancel, ..)
1625 Const cstSubArgs = "[DefaultFolder=""""], [FreeText=""""]"
1627 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1628 sFolder = ""
1630 Check:
1631 If IsMissing(DefaultFolder) Or IsEmpty(DefaultFolder) Then DefaultFolder = ""
1632 If IsMissing(FreeText) Or IsEmpty(FreeText) Then FreeText = ""
1633 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1634 If Not SF_Utils._ValidateFile(DefaultFolder, "DefaultFolder", , True) Then GoTo Finally
1636 End If
1637 DefaultFolder = SF_FileSystem._ConvertToUrl(DefaultFolder)
1639 Try:
1641 If Not IsNull(oFolderDialog) Then
1642 With oFolderDialog
1644 .Description = FreeText
1645 iAccept = .Execute()
1646 ' https://api.libreoffice.org/docs/idl/ref/ExecutableDialogResults_8idl.html
1647 If iAccept = com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then
1648 .DisplayDirectory = .Directory ' Set the next default initial folder to the selected one
1650 End If
1651 End With
1652 End If
1654 Finally:
1655 PickFolder = SF_FileSystem._ConvertFromUrl(sFolder)
1656 SF_Utils._ExitFunction(cstThisSub)
1657 Exit Function
1658 Catch:
1659 GoTo Finally
1660 End Function ' ScriptForge.SF_FileSystem.PickFolder
1662 REM -----------------------------------------------------------------------------
1663 Public Function Properties() As Variant
1664 ''' Return the list or properties of the FileSystem module as an array
1666 Properties = Array( _
1675 )
1677 End Function ' ScriptForge.SF_FileSystem.Properties
1679 REM -----------------------------------------------------------------------------
1680 Public Function SetProperty(Optional ByVal PropertyName As Variant _
1681 , Optional ByRef Value As Variant _
1682 ) As Boolean
1683 ''' Set a new value to the given property
1684 ''' Args:
1685 ''' PropertyName: the name of the property as a string
1686 ''' Value: its new value
1687 ''' Exceptions
1688 ''' ARGUMENTERROR The property does not exist
1693 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1694 SetProperty = False
1696 Check:
1697 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1698 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
1699 End If
1701 Try:
1702 Select Case UCase(PropertyName)
1704 Case Else
1705 End Select
1707 Finally:
1708 SF_Utils._ExitFunction(cstThisSub)
1709 Exit Function
1710 Catch:
1711 GoTo Finally
1712 End Function ' ScriptForge.SF_FileSystem.SetProperty
1714 REM -----------------------------------------------------------------------------
1715 Public Function SubFolders(Optional ByVal FolderName As Variant _
1716 , Optional ByVal Filter As Variant _
1717 ) As Variant
1718 ''' Return an array of the FolderNames stored in the given folder. The folder must exist
1719 ''' Args:
1720 ''' FolderName: the folder to explore
1721 ''' Filter: contains wildcards ("?" and "*") to limit the list to the relevant folders (default = "")
1722 ''' Returns:
1723 ''' An array of strings, each entry is the FolderName of an existing folder
1724 ''' Exceptions:
1725 ''' UNKNOWNFOLDERERROR Folder does not exist
1726 ''' NOTAFOLDERERROR FolderName is a file, not a folder
1727 ''' Example:
1728 ''' Dim a As Variant
1732 Dim vSubFolders As Variant ' Return value
1733 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
1734 Dim sFolderName As String ' URL lias for FolderName
1735 Dim sFolder As String ' Single folder
1736 Dim i As Long
1741 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1742 vSubFolders = Array()
1744 Check:
1745 If IsMissing(Filter) Or IsEmpty(Filter) Then Filter = ""
1746 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1749 End If
1750 sFolderName = SF_FileSystem._ConvertToUrl(FolderName)
1751 If SF_FileSystem.FileExists(FolderName) Then GoTo CatchFile ' Must not be a file
1752 If Not SF_FileSystem.FolderExists(FolderName) Then GoTo CatchFolder ' Folder must exist
1754 Try:
1755 ' Get SubFolders
1757 vSubFolders = oSfa.getFolderContents(sFolderName, True)
1758 ' List includes files; remove them or adjust notations of folders
1759 For i = 0 To UBound(vSubFolders)
1761 If SF_FileSystem.FileExists(sFolder) Then vSubFolders(i) = "" Else vSubFolders(i) = sFolder
1762 ' Reduce list to those passing the filter
1764 sFolder = SF_FileSystem.GetName(vSubFolders(i))
1765 If Not SF_String.IsLike(sFolder, Filter) Then vSubFolders(i) = ""
1766 End If
1767 Next i
1768 vSubFolders = SF_Array.TrimArray(vSubFolders)
1770 Finally:
1771 SubFolders = vSubFolders
1772 SF_Utils._ExitFunction(cstThisSub)
1773 Exit Function
1774 Catch:
1775 GoTo Finally
1776 CatchFile:
1778 GoTo Finally
1779 CatchFolder:
1781 GoTo Finally
1782 End Function ' ScriptForge.SF_FileSystem.SubFolders
1784 REM =========================================================== PRIVATE FUNCTIONS
1786 REM -----------------------------------------------------------------------------
1787 Private Function _ConvertFromUrl(psFile) As String
1788 ''' Execute the builtin ConvertFromUrl function only when relevant
1789 ''' i.e. when FileNaming (how arguments and return values are provided) = "SYS"
1790 ''' Called at the bottom of methods returning file names
1791 ''' Remark: psFile might contain wildcards
1793 Const cstQuestion = "$QUESTION$", cstStar = "$STAR$" ' Special tokens to replace wildcards
1796 _ConvertFromUrl = Replace(Replace( _
1799 Else
1800 _ConvertFromUrl = psFile
1801 End If
1803 End Function ' ScriptForge.FileSystem._ConvertFromUrl
1805 REM -----------------------------------------------------------------------------
1806 Private Function _ConvertToUrl(psFile) As String
1807 ''' Execute the builtin ConvertToUrl function only when relevant
1808 ''' i.e. when FileNaming (how arguments and return values are provided) <> "URL"
1809 ''' Called at the top of methods receiving file names as arguments
1810 ''' Remark: psFile might contain wildcards
1813 _ConvertToUrl = psFile
1814 Else
1817 End If
1819 End Function ' ScriptForge.FileSystem._ConvertToUrl
1821 REM -----------------------------------------------------------------------------
1822 Private Function _CopyMove(psMethod As String _
1823 , psSource As String _
1824 , psDestination As String _
1825 , pbOverWrite As Boolean _
1826 ) As Boolean
1827 ''' Checks the arguments and executes the given method
1828 ''' Args:
1829 ''' psMethod: CopyFile/CopyFolder or MoveFile/MoveFolder
1830 ''' psSource: Either File/FolderName
1831 ''' or NamePattern which can include wildcard characters, for one or more files/folders to be copied
1832 ''' psDestination: FileName or FolderName for copy/move of a single file/folder
1833 ''' Otherwise a destination FolderName. If it does not exist, it is created
1834 ''' pbOverWrite: If True, files/folders may be overwritten
1835 ''' Must be False for Move operations
1836 ''' Next checks are done:
1837 ''' With wildcards (multiple files/folders):
1838 ''' - Parent folder of source must exist
1839 ''' - Destination must not be a file
1840 ''' - Parent folder of Destination must exist
1841 ''' - If the Destination folder does not exist a new folder is created,
1842 ''' - At least one file matches the wildcards expression
1843 ''' - Destination files/folder must not exist if pbOverWrite = False
1844 ''' - Destination files/folders must not have the read-only attribute set
1845 ''' - Destination files must not be folders, destination folders must not be files
1846 ''' Without wildcards (single file/folder):
1847 ''' - Source file/folder must exist and be a file/folder
1848 ''' - Parent folder of Destination must exist
1849 ''' - Destination must not be an existing folder/file
1850 ''' - Destination file/folder must not exist if pbOverWrite = False
1851 ''' - Destination file must not have the read-only attribute set
1853 Dim bCopyMove As Boolean ' Return value
1854 Dim bCopy As Boolean ' True if Copy, False if Move
1855 Dim bFile As Boolean ' True if File, False if Folder
1856 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
1857 Dim bWildCards As Boolean ' True if wildcards found in Source
1858 Dim bCreateFolder As Boolean ' True when the destination folder should be created
1859 Dim bDestExists As Boolean ' True if destination exists
1860 Dim sSourceUrl As String ' Alias for Source
1861 Dim sDestinationUrl As String ' Alias for Destination
1862 Dim sDestinationFile As String ' Destination FileName
1863 Dim sParentFolder As String ' Parent folder of Source
1864 Dim vFiles As Variant ' Array of candidates for copy/move
1865 Dim sFile As String ' Single file/folder
1866 Dim sName As String ' Name (last component) of file
1867 Dim i As Long
1869 ' Error handling left to calling routine
1870 bCopyMove = False
1873 bWildCards = ( InStr(psSource, "*") + InStr(psSource, "?") + InStr(psSource, "%3F") > 0 ) 'ConvertToUrl() converts sometimes "?" to "%3F"
1874 bDestExists = False
1876 With SF_FileSystem
1878 Check:
1879 If bWildCards Then
1880 sParentFolder = .GetParentFolderName(psSource)
1881 If Not .FolderExists(sParentFolder) Then GoTo CatchNoMatch
1882 If .FileExists(psDestination) Then GoTo CatchFileNotFolder
1883 If Not .FolderExists(.GetParentFolderName(psDestination)) Then GoTo CatchDestFolderNotExists
1884 bCreateFolder = Not .FolderExists(psDestination)
1885 Else
1886 Select Case bFile
1887 Case True ' File
1888 If Not .FileExists(psSource) Then GoTo CatchFileNotExists
1889 If Not .FolderExists(.GetParentFolderName(psDestination)) Then GoTo CatchSourceFolderNotExists
1890 If .FolderExists(psDestination) Then GoTo CatchFolderNotFile
1891 bDestExists = .FileExists(psDestination)
1892 If pbOverWrite = False And bDestExists = True Then GoTo CatchDestinationExists
1893 bCreateFolder = False
1894 Case False ' Folder
1895 If Not .FolderExists(psSource) Then GoTo CatchSourceFolderNotExists
1896 If Not .FolderExists(.GetParentFolderName(psDestination)) Then GoTo CatchDestFolderNotExists
1897 If .FileExists(psDestination) Then GoTo CatchFileNotFolder
1898 bDestExists = .FolderExists(psDestination)
1899 If pbOverWrite = False And bDestExists Then GoTo CatchDestinationExists
1900 bCreateFolder = Not bDestExists
1901 End Select
1902 End If
1904 Try:
1906 If bWildCards Then
1907 If bFile Then vFiles = .Files(sParentFolder, .GetName(psSource)) Else vFiles = .SubFolders(sParentFolder, .GetName(psSource))
1909 ' Go through the candidates
1910 If bCreateFolder Then .CreateFolder(psDestination)
1911 For i = 0 To UBound(vFiles)
1912 sFile = vFiles(i)
1913 sDestinationFile = .BuildPath(psDestination, .GetName(sFile))
1914 If bFile Then bDestExists = .FileExists(sDestinationFile) Else bDestExists = .FolderExists(sDestinationFile)
1915 If pbOverWrite = False Then
1916 If bDestExists Then GoTo CatchDestinationExists
1917 If .FolderExists(sDestinationFile) Then GoTo CatchDestinationExists
1918 End If
1919 sSourceUrl = ._ConvertToUrl(sFile)
1920 sDestinationUrl = ._ConvertToUrl(sDestinationFile)
1921 If bDestExists Then
1922 If oSfa.isReadOnly(sDestinationUrl) Then GoTo CatchDestinationReadOnly
1923 End If
1924 Select Case bCopy
1925 Case True : oSfa.copy(sSourceUrl, sDestinationUrl)
1926 Case False : oSfa.move(sSourceUrl, sDestinationUrl)
1927 End Select
1928 Next i
1929 Else
1930 sSourceUrl = ._ConvertToUrl(psSource)
1931 sDestinationUrl = ._ConvertToUrl(psDestination)
1932 If bDestExists Then
1933 If oSfa.isReadOnly(sDestinationUrl) Then GoTo CatchDestinationReadOnly
1934 End If
1935 If bCreateFolder Then .CreateFolder(psDestination)
1936 Select Case bCopy
1937 Case True : oSfa.copy(sSourceUrl, sDestinationUrl)
1938 Case False : oSfa.move(sSourceUrl, sDestinationUrl)
1939 End Select
1940 End If
1942 End With
1944 bCopyMove = True
1946 Finally:
1947 _CopyMove = bCopyMove
1948 Exit Function
1949 CatchFileNotExists:
1951 GoTo Finally
1952 CatchSourceFolderNotExists:
1954 GoTo Finally
1955 CatchDestFolderNotExists:
1957 GoTo Finally
1958 CatchFolderNotFile:
1960 GoTo Finally
1961 CatchDestinationExists:
1963 GoTo Finally
1964 CatchNoMatch:
1966 GoTo Finally
1967 CatchFileNotFolder:
1969 GoTo Finally
1970 CatchDestinationReadOnly:
1971 SF_Exception.RaiseFatal(READONLYERROR, "Destination", Iif(bWildCards, sDestinationFile, psDestination))
1972 GoTo Finally
1973 End Function ' ScriptForge.SF_FileSystem._CopyMove
1975 REM -----------------------------------------------------------------------------
1976 Public Function _CountTextLines(ByVal psFileName As String _
1977 , Optional ByVal pbIncludeBlanks As Boolean _
1978 ) As Long
1979 ''' Convenient function to count the number of lines in a textfile
1980 ''' Args:
1981 ''' psFileName: the file in FileNaming notation
1982 ''' pbIncludeBlanks: if True (default), zero-length lines are included
1983 ''' Returns:
1986 Dim lLines As Long ' Return value
1987 Dim oFile As Object ' File handler
1988 Dim sLine As String ' The last line read
1990 Try:
1991 lLines = 0
1992 If IsMissing(pbIncludeBlanks) Then pbIncludeBlanks = True
1993 Set oFile = SF_FileSystem.OpenTextFile(psFileName, ForReading)
1994 With oFile
1995 If Not IsNull(oFile) Then
1996 Do While Not .AtEndOfStream
1997 sLine = .ReadLine()
1999 Loop
2000 End If
2001 .CloseFile()
2002 Set oFile = .Dispose()
2003 End With
2005 Finally:
2006 _CountTextLines = lLines
2007 Exit Function
2008 End Function ' ScriptForge.SF_FileSystem._CountTextLines
2010 REM -----------------------------------------------------------------------------
2011 Private Function _Delete(psMethod As String _
2012 , psFile As String _
2013 ) As Boolean
2014 ''' Checks the argument and executes the given psMethod
2015 ''' Args:
2016 ''' psMethod: CopyFile/CopyFolder or MoveFile/MoveFolder
2017 ''' psFile: Either File/FolderName
2018 ''' or NamePattern which can include wildcard characters, for one or more files/folders to be deleted
2019 ''' Next checks are done:
2020 ''' With wildcards (multiple files/folders):
2021 ''' - Parent folder of File must exist
2022 ''' - At least one file matches the wildcards expression
2023 ''' - Files or folders to delete must not have the read-only attribute set
2024 ''' Without wildcards (single file/folder):
2025 ''' - File/folder must exist and be a file/folder
2026 ''' - A file or folder to delete must not have the read-only attribute set
2028 Dim bDelete As Boolean ' Return value
2029 Dim bFile As Boolean ' True if File, False if Folder
2030 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
2031 Dim bWildCards As Boolean ' True if wildcards found in File
2032 Dim sFileUrl As String ' Alias for File
2033 Dim sParentFolder As String ' Parent folder of File
2034 Dim vFiles As Variant ' Array of candidates for deletion
2035 Dim sFile As String ' Single file/folder
2036 Dim sName As String ' Name (last component) of file
2037 Dim i As Long
2039 ' Error handling left to calling routine
2040 bDelete = False
2042 bWildCards = ( InStr(psFile, "*") + InStr(psFile, "?") + InStr(psFile, "%3F") > 0 ) 'ConvertToUrl() converts sometimes "?" to "%3F"
2044 With SF_FileSystem
2046 Check:
2047 If bWildCards Then
2048 sParentFolder = .GetParentFolderName(psFile)
2049 If Not .FolderExists(sParentFolder) Then GoTo CatchNoMatch
2050 Else
2051 Select Case bFile
2052 Case True ' File
2053 If .FolderExists(psFile) Then GoTo CatchFolderNotFile
2054 If Not .FileExists(psFile) Then GoTo CatchFileNotExists
2055 Case False ' Folder
2056 If .FileExists(psFile) Then GoTo CatchFileNotFolder
2057 If Not .FolderExists(psFile) Then GoTo CatchFolderNotExists
2058 End Select
2059 End If
2061 Try:
2063 If bWildCards Then
2064 If bFile Then vFiles = .Files(sParentFolder) Else vFiles = .SubFolders(sParentFolder)
2065 ' Select candidates
2066 For i = 0 To UBound(vFiles)
2067 If Not SF_String.IsLike(.GetName(vFiles(i)), .GetName(psFile)) Then vFiles(i) = ""
2068 Next i
2069 vFiles = SF_Array.TrimArray(vFiles)
2071 ' Go through the candidates
2072 For i = 0 To UBound(vFiles)
2073 sFile = vFiles(i)
2074 sFileUrl = ._ConvertToUrl(sFile)
2075 If oSfa.isReadOnly(sFileUrl) Then GoTo CatchReadOnly
2076 oSfa.kill(sFileUrl)
2077 Next i
2078 Else
2079 sFileUrl = ._ConvertToUrl(psFile)
2080 If oSfa.isReadOnly(sFileUrl) Then GoTo CatchReadOnly
2081 oSfa.kill(sFileUrl)
2082 End If
2084 End With
2086 bDelete = True
2088 Finally:
2089 _Delete = bDelete
2090 Exit Function
2091 CatchFolderNotExists:
2093 GoTo Finally
2094 CatchFileNotExists:
2096 GoTo Finally
2097 CatchFolderNotFile:
2099 GoTo Finally
2100 CatchNoMatch:
2101 SF_Exception.RaiseFatal(NOFILEMATCHERROR, Iif(bFile, "FileName", "FolderName"), psFile)
2102 GoTo Finally
2103 CatchFileNotFolder:
2105 GoTo Finally
2106 CatchReadOnly:
2107 SF_Exception.RaiseFatal(READONLYERROR, Iif(bFile, "FileName", "FolderName"), Iif(bWildCards, sFile, psFile))
2108 GoTo Finally
2109 End Function ' ScriptForge.SF_FileSystem._Delete
2111 REM -----------------------------------------------------------------------------
2112 Private Function _GetConfigFolder(ByVal psFolder As String) As String
2113 ''' Returns one of next configuration folders: see https://api.libreoffice.org/docs/idl/ref/servicecom_1_1sun_1_1star_1_1util_1_1PathSubstitution.html
2117 ''' work => The work directory of the user. Under Windows this would be the "MyDocuments" subdirectory. Under Unix this would be the home-directory
2118 ''' home => The home directory of the user. Under Unix this would be the home- directory.
2119 ''' Under Windows this would be the CSIDL_PERSONAL directory, for example "Documents and Settings\<username>\Documents"
2122 Dim oSubst As Object ' com.sun.star.util.PathSubstitution
2123 Dim sConfig As String ' Return value
2125 sConfig = ""
2127 If Not IsNull(oSubst) Then sConfig = oSubst.getSubstituteVariableValue("$(" & psFolder & ")") & "/"
2129 _GetConfigFolder = SF_FileSystem._ConvertFromUrl(sConfig)
2131 End Function ' ScriptForge.FileSystem._GetConfigFolder
2133 REM -----------------------------------------------------------------------------
2134 Public Function _ParseUrl(psUrl As String) As Object
2135 ''' Returns a com.sun.star.util.URL structure based on the argument
2137 Dim oParse As Object ' com.sun.star.util.URLTransformer
2138 Dim bParsed As Boolean ' True if parsing is successful
2139 Dim oUrl As New com.sun.star.util.URL ' Return value
2141 oUrl.Complete = psUrl
2143 bParsed = oParse.parseStrict(oUrl, "")
2144 If bParsed Then oUrl.Path = ConvertToUrl(oUrl.Path)
2146 Set _ParseUrl = oUrl
2148 End Function ' ScriptForge.SF_FileSystem._ParseUrl
2150 REM -----------------------------------------------------------------------------
2151 Public Function _SFInstallFolder() As String
2152 ''' Returns the installation folder of the ScriptForge library
2153 ''' Either:
2155 ''' ($config)/basic/ScriptForge
2157 ''' ($install)/share/basic/ScriptForge
2159 Dim sFolder As String ' Folder
2161 _SFInstallFolder = ""
2164 If Not FolderExists(sFolder) Then
2166 If Not FolderExists(sFolder) Then Exit Function
2167 End If
2169 _SFInstallFolder = _ConvertFromUrl(sFolder)
2171 End Function ' ScriptForge.SF_FileSystem._SFInstallFolder
2173 REM ============================================ END OF SCRIPTFORGE.SF_FileSystem
2174 </script:module>