| blob | 3860bebd1b0aa4188ef032fef7dfa150153a9b0a |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_TextStream" 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 ClassModule
11 Option Explicit
13 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
14 ''' SF_TextStream
15 ''' =============
16 ''' Class instantiated by the
17 ''' SF_FileSystem.CreateTextFile
18 ''' SF_FileSystem.OpenTextFile
19 ''' methods to facilitate the sequential processing of text files
20 ''' All open/read/write/close operations are presumed to happen during the same macro run
21 ''' The encoding to be used may be chosen by the user
22 ''' The list is in the Name column of https://www.iana.org/assignments/character-sets/character-sets.xhtml
23 ''' Note that probably not all values are available
24 ''' Line delimiters may be chosen by the user
25 ''' In input, CR, LF or CR+LF are supported
26 ''' In output, the default value is the usual newline on the actual operating system (see SF_FileSystem.sfNEWLINE)
27 '''
28 ''' The design choices are largely inspired by
29 ''' https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/textstream-object
30 ''' The implementation is mainly based on the XTextInputStream and XTextOutputStream UNO interfaces
31 ''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1io_1_1XTextInputStream.html
32 ''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1io_1_1XTextOutputStream.html
33 '''
35 ''' All methods and properties are applicable without restrictions on both file systems.
36 ''' However, when updates are operated on text files embedded in a document, (with the WriteXXX() methods),
37 ''' the updates are first done on a copy of the original file. When the file is closed, the copy
38 ''' will overwrite the original file. The whole process is transparent for the user script.
39 '''
40 ''' Instantiation example:
41 ''' Dim FSO As Object, myFile As Object
43 ''' Set myFile = FSO.OpenTextFile("C:\Temp\ThisFile.txt", FSO.ForReading) ' Once per file
44 '''
45 ''' Detailed user documentation:
46 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_textstream.html?DbPAR=BASIC
47 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
49 REM ================================================================== EXCEPTIONS
52 Const FILEOPENMODEERROR = "FILEOPENMODEERROR" ' The file is open in incompatible mode
53 Const ENDOFFILEERROR = "ENDOFFILEERROR" ' When file was read, an end-of-file was encountered
55 REM ============================================================= PRIVATE MEMBERS
57 Private [Me] As Object
58 Private [_Parent] As Object
59 Private ObjectType As String ' Must be TEXTSTREAM
60 Private ServiceName As String
61 Private _FileName As String ' File where it is about in URL format
62 Private _IOMode As Integer ' ForReading, ForWriting or ForAppending
63 Private _Encoding As String ' https://www.iana.org/assignments/character-sets/character-sets.xhtml
64 Private _NewLine As String ' Line break in write mode
65 Private _FileExists As Boolean ' True if file exists before open
66 Private _LineNumber As Long ' Number of lines read or written
67 Private _FileHandler As Object ' com.sun.star.io.XInputStream or
68 ' com.sun.star.io.XOutputStream or
69 ' com.sun.star.io.XStream
70 Private _InputStream As Object ' com.sun.star.io.TextInputStream
71 Private _OutputStream As Object ' com.sun.star.io.TextOutputStream
72 Private _ForceBlankLine As Boolean ' Workaround: XTextInputStream misses last line if file ends with newline
75 Private _IsEmbeddedFile As Boolean ' True when concerned file is embedded in a document
76 Private _EmbeddedFileName As String ' When not blank and in update mode, the full embedded file name
77 ' This file is initially copied in a temporary storage, modified by the actual class,
78 ' and rewritten in the document when the textstream.CloseFile() method is run
80 REM ============================================================ MODULE CONSTANTS
82 REM ===================================================== CONSTRUCTOR/DESTRUCTOR
84 REM -----------------------------------------------------------------------------
85 Private Sub Class_Initialize()
86 Set [Me] = Nothing
87 Set [_Parent] = Nothing
90 _FileName = ""
91 _IOMode = -1
92 _Encoding = ""
93 _NewLine = ""
94 _FileExists = False
95 _LineNumber = 0
96 Set _FileHandler = Nothing
97 Set _InputStream = Nothing
98 Set _OutputStream = Nothing
99 _ForceBlankLine = False
100 _IsEmbeddedFile = False
101 _EmbeddedFileName = ""
102 End Sub ' ScriptForge.SF_TextStream Constructor
104 REM -----------------------------------------------------------------------------
105 Private Sub Class_Terminate()
106 Call Class_Initialize()
107 End Sub ' ScriptForge.SF_TextStream Destructor
109 REM -----------------------------------------------------------------------------
110 Public Function Dispose() As Variant
111 Call Class_Terminate()
112 Set Dispose = Nothing
113 End Function ' ScriptForge.SF_TextStream Explicit Destructor
115 REM ================================================================== PROPERTIES
117 REM -----------------------------------------------------------------------------
118 Property Get AtEndOfStream() As Boolean
119 ''' In reading mode, True indicates that the end of the file has been reached
121 ''' The property should be invoked BEFORE each ReadLine() method:
122 ''' A ReadLine() executed while AtEndOfStream is True will raise an error
123 ''' Example:
124 ''' Dim sLine As String
125 ''' Do While Not myFile.AtEndOfStream
126 ''' sLine = myFile.ReadLine()
127 ''' ' ...
128 ''' Loop
132 End Property ' ScriptForge.SF_TextStream.AtEndOfStream
134 REM -----------------------------------------------------------------------------
135 Property Get Encoding() As String
136 ''' Returns the name of the text file either in url or in native operating system format
137 ''' Example:
138 ''' Dim myFile As Object
145 End Property ' ScriptForge.SF_TextStream.Encoding
147 REM -----------------------------------------------------------------------------
148 Property Get FileName() As String
149 ''' Returns the name of the text file either in url or in native operating system format
150 ''' Example:
151 ''' Dim myFile As Object
158 End Property ' ScriptForge.SF_TextStream.FileName
160 REM -----------------------------------------------------------------------------
161 Property Get IOMode() As String
163 ''' Example:
164 ''' Dim myFile As Object
171 End Property ' ScriptForge.SF_TextStream.IOMode
173 REM -----------------------------------------------------------------------------
174 Property Get Line() As Long
175 ''' Returns the number of lines read or written so far
176 ''' Example:
177 ''' Dim myFile As Object
179 ''' Set myFile = FSO.OpenTextFile("C:\Temp\myFile.txt", FSO.ForAppending)
184 End Property ' ScriptForge.SF_TextStream.Line
186 REM -----------------------------------------------------------------------------
187 Property Get NewLine() As Variant
188 ''' Returns the current character string to be inserted between 2 successive written lines
189 ''' The default value is the native line separator in the current operating system
190 ''' Example:
191 ''' MsgBox myFile.NewLine
195 End Property ' ScriptForge.SF_TextStream.NewLine (get)
197 REM -----------------------------------------------------------------------------
198 Property Let NewLine(ByVal pvLineBreak As Variant)
199 ''' Sets the current character string to be inserted between 2 successive written lines
200 ''' Example:
205 SF_Utils._EnterFunction(cstThisSub)
206 If VarType(pvLineBreak) = V_STRING Then _NewLine = pvLineBreak
207 SF_Utils._ExitFunction(cstThisSub)
209 End Property ' ScriptForge.SF_TextStream.NewLine (let)
211 REM ===================================================================== METHODS
213 REM -----------------------------------------------------------------------------
214 Public Function CloseFile() As Boolean
215 ''' Empties the output buffer if relevant. Closes the actual input or output stream
216 ''' Args:
217 ''' Returns:
218 ''' True if the closure was successful
219 ''' Exceptions:
220 ''' FILENOTOPENERROR Nothing found to close
221 ''' Examples:
222 ''' myFile.CloseFile()
224 Dim bClose As Boolean ' Return value
225 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
227 Const cstSubArgs = ""
229 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
230 bClose = False
232 Check:
233 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
234 If Not _IsFileOpen() Then GoTo Finally
236 Try:
237 If Not IsNull(_InputStream) Then _InputStream.closeInput()
238 If Not IsNull(_OutputStream) Then
239 _OutputStream.flush()
240 _OutputStream.closeOutput()
241 End If
242 Set _InputStream = Nothing
243 Set _OutputStream = Nothing
244 Set _FileHandler = Nothing
246 ' Manage embedded file closure: copy temporary file to document internal storage
247 If _IsEmbeddedFile Then
249 oSfa.copy(_FileName, _EmbeddedFileName)
250 End If
252 bClose = True
254 Finally:
255 CloseFile = bClose
256 SF_Utils._ExitFunction(cstThisSub)
257 Exit Function
258 Catch:
259 GoTo Finally
260 End Function ' ScriptForge.SF_TextStream.CloseFile
262 REM -----------------------------------------------------------------------------
263 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
264 ''' Return the actual value of the given property
265 ''' Args:
266 ''' PropertyName: the name of the property as a string
267 ''' Returns:
268 ''' The actual value of the property
269 ''' If the property does not exist, returns Null
270 ''' Exceptions:
271 ''' see the exceptions of the individual properties
272 ''' Examples:
276 Const cstSubArgs = ""
278 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
279 GetProperty = Null
281 Check:
282 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
283 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
284 End If
286 Try:
287 GetProperty = _PropertyGet(PropertyName)
289 Finally:
290 SF_Utils._ExitFunction(cstThisSub)
291 Exit Function
292 Catch:
293 GoTo Finally
294 End Function ' ScriptForge.SF_TextStream.GetProperty
296 REM -----------------------------------------------------------------------------
297 Public Function Methods() As Variant
298 ''' Return the list of public methods of the Model service as an array
300 Methods = Array( _
307 )
309 End Function ' ScriptForge.SF_TextStream.Methods
311 REM -----------------------------------------------------------------------------
312 Public Function Properties() As Variant
313 ''' Return the list or properties of the Timer class as an array
315 Properties = Array( _
322 )
324 End Function ' ScriptForge.SF_TextStream.Properties
326 REM -----------------------------------------------------------------------------
327 Public Function ReadAll() As String
328 ''' Returns all the remaining lines in the text stream as one string. Line breaks are NOT removed
329 ''' The resulting string can be split in lines
330 ''' either by using the usual Split Basic builtin function if the line delimiter is known
331 ''' or with the SF_String.SplitLines method
332 ''' For large files, using the ReadAll method wastes memory resources.
333 ''' Other techniques should be used to input a file, such as reading a file line-by-line
334 ''' Args:
335 ''' Returns:
336 ''' The read lines. The string may be empty.
338 ''' Exceptions:
339 ''' FILENOTOPENERROR File not open or already closed
340 ''' FILEOPENMODEERROR File opened in write or append modes
341 ''' ENDOFFILEERROR Previous reads already reached the end of the file
342 ''' Examples:
343 ''' Dim a As String
344 ''' a = myFile.ReadAll()
346 Dim sRead As String ' Return value
348 Const cstSubArgs = ""
350 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
351 sRead = ""
353 Check:
354 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
356 If _InputStream.isEOF() Then GoTo CatchEOF
357 End If
359 Try:
360 sRead = _InputStream.readString(Array(), False)
361 _LineNumber = _LineNumber + 1
363 Finally:
364 ReadAll = sRead
365 SF_Utils._ExitFunction(cstThisSub)
366 Exit Function
367 Catch:
368 GoTo Finally
369 CatchEOF:
370 SF_Exception.RaiseFatal(ENDOFFILEERROR, FileName)
371 GoTo Finally
372 End Function ' ScriptForge.SF_TextStream.ReadAll
374 REM -----------------------------------------------------------------------------
375 Public Function ReadLine() As String
376 ''' Returns the next line in the text stream as a string. Line breaks are removed.
377 ''' Args:
378 ''' Returns:
379 ''' The read line. The string may be empty.
380 ''' Exceptions:
381 ''' FILENOTOPENERROR File not open or already closed
382 ''' FILEOPENMODEERROR File opened in write or append modes
383 ''' ENDOFFILEERROR Previous reads already reached the end of the file
384 ''' Examples:
385 ''' Dim a As String
386 ''' a = myFile.ReadLine()
388 Dim sRead As String ' Return value
389 Dim iRead As Integer ' Length of line break
391 Const cstSubArgs = ""
393 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
394 sRead = ""
396 Check:
397 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
399 If AtEndOfStream Then GoTo CatchEOF
400 End If
402 Try:
403 ' When the text file ends with a line break,
404 ' XTextInputStream.readLine() returns the line break together with the last line
405 ' Hence the workaround to force a blank line at the end
406 If _ForceBlankLine Then
407 sRead = ""
408 _ForceBlankLine = False
409 Else
410 sRead = _InputStream.readLine()
411 ' The isEOF() is set immediately after having read the last line
413 iRead = 0
414 If SF_String.EndsWith(sRead, SF_String.sfCRLF) Then
415 iRead = 2
416 ElseIf SF_String.EndsWith(sRead, SF_String.sfLF) Or SF_String.EndsWith(sRead, SF_String.sfCR) Then
417 iRead = 1
418 End If
420 sRead = Left(sRead, Len(sRead) - iRead)
421 _ForceBlankLine = True ' Provision for a last empty line at the next read loop
422 End If
423 End If
424 End If
425 _LineNumber = _LineNumber + 1
427 Finally:
428 ReadLine = sRead
429 SF_Utils._ExitFunction(cstThisSub)
430 Exit Function
431 Catch:
432 GoTo Finally
433 CatchEOF:
434 SF_Exception.RaiseFatal(ENDOFFILEERROR, FileName)
435 GoTo Finally
436 End Function ' ScriptForge.SF_TextStream.ReadLine
438 REM -----------------------------------------------------------------------------
439 Public Function SetProperty(Optional ByVal PropertyName As Variant _
440 , Optional ByRef Value As Variant _
441 ) As Boolean
442 ''' Set a new value to the given property
443 ''' Args:
444 ''' PropertyName: the name of the property as a string
445 ''' Value: its new value
446 ''' Exceptions
447 ''' ARGUMENTERROR The property does not exist
449 Dim bSet As Boolean ' Return value
453 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
454 bSet = False
456 Check:
457 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
458 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
459 End If
461 Try:
462 bSet = True
463 Select Case UCase(PropertyName)
466 NewLine = Value
467 Case Else
468 bSet = False
469 End Select
471 Finally:
472 SetProperty = bSet
473 SF_Utils._ExitFunction(cstThisSub)
474 Exit Function
475 Catch:
476 GoTo Finally
477 End Function ' ScriptForge.SF_TextStream.SetProperty
479 REM -----------------------------------------------------------------------------
480 Public Sub SkipLine()
481 ''' Skips the next line when reading a TextStream file.
482 ''' Args:
483 ''' Exceptions:
484 ''' FILENOTOPENERROR File not open or already closed
485 ''' FILEOPENMODEERROR File opened in write or append modes
486 ''' ENDOFFILEERROR Previous reads already reached the end of the file
487 ''' Examples:
488 ''' myFile.SkipLine()
490 Dim sRead As String ' Read buffer
492 Const cstSubArgs = ""
494 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
496 Check:
497 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
499 If Not _ForceBlankLine Then ' The file ends with a newline => return one empty line more
500 If _InputStream.isEOF() Then GoTo CatchEOF
501 End If
502 End If
504 Try:
505 sRead = ReadLine()
507 Finally:
508 SF_Utils._ExitFunction(cstThisSub)
509 Exit Sub
510 Catch:
511 GoTo Finally
512 CatchEOF:
513 SF_Exception.RaiseFatal(ENDOFFILEERROR, FileName)
514 GoTo Finally
515 End Sub ' ScriptForge.SF_TextStream.SkipLine
517 REM -----------------------------------------------------------------------------
518 Public Sub WriteBlankLines(Optional ByVal Lines As Variant)
519 ''' Writes a number of empty lines in the output stream
520 ''' Args:
521 ''' Lines: the number of lines to write
522 ''' Returns:
523 ''' Exceptions:
524 ''' FILENOTOPENERROR File not open or already closed
525 ''' FILEOPENMODEERROR File opened in read mode
526 ''' Examples:
528 Dim i As Long
532 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
534 Check:
535 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
538 End If
540 Try:
541 For i = 1 To Lines
542 _OutputStream.writeString(_NewLine)
543 Next i
544 _LineNumber = _LineNumber + Lines
546 Finally:
547 SF_Utils._ExitFunction(cstThisSub)
548 Exit Sub
549 Catch:
550 GoTo Finally
551 End Sub ' ScriptForge.SF_TextStream.WriteBlankLines
553 REM -----------------------------------------------------------------------------
554 Public Sub WriteLine(Optional ByVal Line As Variant)
555 ''' Writes the given line to the output stream. A newline is inserted if relevant
556 ''' Args:
557 ''' Line: the line to write, may be empty
558 ''' Returns:
559 ''' Exceptions:
560 ''' FILENOTOPENERROR File not open or already closed
561 ''' FILEOPENMODEERROR File opened in in read mode
562 ''' Examples:
564 Dim i As Long
568 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
570 Check:
571 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
574 End If
576 Try:
578 _LineNumber = _LineNumber + 1
580 Finally:
581 SF_Utils._ExitFunction(cstThisSub)
582 Exit Sub
583 Catch:
584 GoTo Finally
585 End Sub ' ScriptForge.SF_TextStream.WriteLine
587 REM =========================================================== PRIVATE FUNCTIONS
589 REM -----------------------------------------------------------------------------
590 Public Sub _Initialize()
591 ''' Opens file and setup input and/or output streams (ForAppending requires both)
593 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
595 ' Default newline related to current operating system
596 _NewLine = SF_String.sfNEWLINE
600 ' Setup input and/or output streams based on READ/WRITE/APPEND IO modes
601 Select Case _IOMode
602 Case SF_FileSystem.ForReading
603 Set _FileHandler = oSfa.openFileRead(_FileName)
605 _InputStream.setInputStream(_FileHandler)
606 Case SF_FileSystem.ForWriting
607 ' Output file is deleted beforehand
608 If _FileExists Then oSfa.kill(_FileName)
609 Set _FileHandler = oSfa.openFileWrite(_FileName)
611 _OutputStream.setOutputStream(_FileHandler)
612 Case SF_FileSystem.ForAppending
613 Set _FileHandler = oSfa.openFileReadWrite(_FileName)
616 _InputStream.setInputStream(_FileHandler)
617 ' Position at end of file: Skip and count existing lines
618 _LineNumber = 0
619 Do While Not _InputStream.isEOF()
620 _InputStream.readLine()
621 _LineNumber = _LineNumber + 1
622 Loop
623 _OutputStream.setOutputStream(_FileHandler)
624 End Select
627 If Not IsNull(_InputStream) Then _InputStream.setEncoding(_Encoding)
628 If Not IsNull(_OutputStream) Then _OutputStream.setEncoding(_Encoding)
630 End Sub ' ScriptForge.SF_TextStream._Initialize
632 REM -----------------------------------------------------------------------------
633 Private Function _IsFileOpen(Optional ByVal psMode As String) As Boolean
634 ''' Checks if file is open with the right mode (READ or WRITE)
635 ''' Raises an exception if the file is not open at all or not in the right mode
636 ''' Args:
637 ''' psMode: READ or WRITE or zero-length string
638 ''' Exceptions:
639 ''' FILENOTOPENERROR File not open or already closed
640 ''' FILEOPENMODEERROR File opened in incompatible mode
642 _IsFileOpen = False
643 If IsMissing(psMode) Then psMode = ""
644 If IsNull(_InputStream) And IsNull(_OutputStream) Then GoTo CatchNotOpen
645 Select Case psMode
647 If IsNull(_InputStream) Then GoTo CatchOpenMode
648 If _IOMode <> SF_FileSystem.ForReading Then GoTo CatchOpenMode
650 If IsNull(_OutputStream) Then GoTo CatchOpenMode
651 If _IOMode = SF_FileSystem.ForReading Then GoTo CatchOpenMode
652 Case Else
653 End Select
654 _IsFileOpen = True
656 Finally:
657 Exit Function
658 CatchNotOpen:
659 SF_Exception.RaiseFatal(FILENOTOPENERROR, FileName)
660 GoTo Finally
661 CatchOpenMode:
662 SF_Exception.RaiseFatal(FILEOPENMODEERROR, FileName, IOMode)
663 GoTo Finally
664 End Function ' ScriptForge.SF_TextStream._IsFileOpen
666 REM -----------------------------------------------------------------------------
667 Private Function _PropertyGet(Optional ByVal psProperty As String)
668 ''' Return the value of the named property
669 ''' Args:
670 ''' psProperty: the name of the property
672 Dim cstThisSub As String
673 Dim cstSubArgs As String
676 cstSubArgs = ""
677 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
679 Select Case UCase(psProperty)
681 Select Case _IOMode
682 Case SF_FileSystem.ForReading
683 If IsNull(_InputStream) Then _PropertyGet = True Else _PropertyGet = CBool(_InputStream.isEOF() And Not _ForceBlankLine)
684 Case Else : _PropertyGet = True
685 End Select
687 _PropertyGet = _Encoding
689 ' Requested is the user visible file name in FileNaming notation
690 _PropertyGet = SF_FileSystem._ConvertFromUrl(Iif(_IsEmbeddedFile, _EmbeddedFileName, _FileName))
692 With SF_FileSystem
693 Select Case _IOMode
697 Case Else : _PropertyGet = ""
698 End Select
699 End With
701 _PropertyGet = _LineNumber
703 _PropertyGet = _NewLine
704 Case Else
705 _PropertyGet = Null
706 End Select
708 Finally:
709 SF_Utils._ExitFunction(cstThisSub)
710 Exit Function
711 End Function ' ScriptForge.SF_TextStream._PropertyGet
713 REM -----------------------------------------------------------------------------
714 Private Function _Repr() As String
715 ''' Convert the TextStream instance to a readable string, typically for debugging purposes (DebugPrint ...)
716 ''' Args:
717 ''' Return:
720 _Repr = "[TextStream]: " & FileName & "," & IOMode & "," & CStr(Line)
722 End Function ' ScriptForge.SF_TextStream._Repr
724 REM ============================================ END OF SCRIPTFORGE.SF_TextStream
725 </script:module>