| blob | 35f1b6fb2b492e43919631427a91cd43c084a7f7 |
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 '''
34 ''' Instantiation example:
35 ''' Dim FSO As Object, myFile As Object
37 ''' Set myFile = FSO.OpenTextFile("C:\Temp\ThisFile.txt", FSO.ForReading) ' Once per file
38 '''
39 ''' Detailed user documentation:
40 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_textstream.html?DbPAR=BASIC
41 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
43 REM ================================================================== EXCEPTIONS
46 Const FILEOPENMODEERROR = "FILEOPENMODEERROR" ' The file is open in incompatible mode
47 Const ENDOFFILEERROR = "ENDOFFILEERROR" ' When file was read, an end-of-file was encountered
49 REM ============================================================= PRIVATE MEMBERS
51 Private [Me] As Object
52 Private [_Parent] As Object
53 Private ObjectType As String ' Must be TEXTSTREAM
54 Private ServiceName As String
55 Private _FileName As String ' File where it is about
56 Private _IOMode As Integer ' ForReading, ForWriting or ForAppending
57 Private _Encoding As String ' https://www.iana.org/assignments/character-sets/character-sets.xhtml
58 Private _NewLine As String ' Line break in write mode
59 Private _FileExists As Boolean ' True if file exists before open
60 Private _LineNumber As Long ' Number of lines read or written
61 Private _FileHandler As Object ' com.sun.star.io.XInputStream or
62 ' com.sun.star.io.XOutputStream or
63 ' com.sun.star.io.XStream
64 Private _InputStream As Object ' com.sun.star.io.TextInputStream
65 Private _OutputStream As Object ' com.sun.star.io.TextOutputStream
66 Private _ForceBlankLine As Boolean ' Workaround: XTextInputStream misses last line if file ends with newline
68 REM ============================================================ MODULE CONSTANTS
70 REM ===================================================== CONSTRUCTOR/DESTRUCTOR
72 REM -----------------------------------------------------------------------------
73 Private Sub Class_Initialize()
74 Set [Me] = Nothing
75 Set [_Parent] = Nothing
78 _FileName = ""
79 _IOMode = -1
80 _Encoding = ""
81 _NewLine = ""
82 _FileExists = False
83 _LineNumber = 0
84 Set _FileHandler = Nothing
85 Set _InputStream = Nothing
86 Set _OutputStream = Nothing
87 _ForceBlankLine = False
88 End Sub ' ScriptForge.SF_TextStream Constructor
90 REM -----------------------------------------------------------------------------
91 Private Sub Class_Terminate()
92 Call Class_Initialize()
93 End Sub ' ScriptForge.SF_TextStream Destructor
95 REM -----------------------------------------------------------------------------
96 Public Function Dispose() As Variant
97 Call Class_Terminate()
98 Set Dispose = Nothing
99 End Function ' ScriptForge.SF_TextStream Explicit Destructor
101 REM ================================================================== PROPERTIES
103 REM -----------------------------------------------------------------------------
104 Property Get AtEndOfStream() As Boolean
105 ''' In reading mode, True indicates that the end of the file has been reached
107 ''' The property should be invoked BEFORE each ReadLine() method:
108 ''' A ReadLine() executed while AtEndOfStream is True will raise an error
109 ''' Example:
110 ''' Dim sLine As String
111 ''' Do While Not myFile.AtEndOfStream
112 ''' sLine = myFile.ReadLine()
113 ''' ' ...
114 ''' Loop
118 End Property ' ScriptForge.SF_TextStream.AtEndOfStream
120 REM -----------------------------------------------------------------------------
121 Property Get Encoding() As String
122 ''' Returns the name of the text file either in url or in native operating system format
123 ''' Example:
124 ''' Dim myFile As Object
131 End Property ' ScriptForge.SF_TextStream.Encoding
133 REM -----------------------------------------------------------------------------
134 Property Get FileName() As String
135 ''' Returns the name of the text file either in url or in native operating system format
136 ''' Example:
137 ''' Dim myFile As Object
144 End Property ' ScriptForge.SF_TextStream.FileName
146 REM -----------------------------------------------------------------------------
147 Property Get IOMode() As String
149 ''' Example:
150 ''' Dim myFile As Object
157 End Property ' ScriptForge.SF_TextStream.IOMode
159 REM -----------------------------------------------------------------------------
160 Property Get Line() As Long
161 ''' Returns the number of lines read or written so far
162 ''' Example:
163 ''' Dim myFile As Object
165 ''' Set myFile = FSO.OpenTextFile("C:\Temp\myFile.txt", FSO.ForAppending)
170 End Property ' ScriptForge.SF_TextStream.Line
172 REM -----------------------------------------------------------------------------
173 Property Get NewLine() As Variant
174 ''' Returns the current character string to be inserted between 2 successive written lines
175 ''' The default value is the native line separator in the current operating system
176 ''' Example:
177 ''' MsgBox myFile.NewLine
181 End Property ' ScriptForge.SF_TextStream.NewLine (get)
183 REM -----------------------------------------------------------------------------
184 Property Let NewLine(ByVal pvLineBreak As Variant)
185 ''' Sets the current character string to be inserted between 2 successive written lines
186 ''' Example:
191 SF_Utils._EnterFunction(cstThisSub)
192 If VarType(pvLineBreak) = V_STRING Then _NewLine = pvLineBreak
193 SF_Utils._ExitFunction(cstThisSub)
195 End Property ' ScriptForge.SF_TextStream.NewLine (let)
197 REM ===================================================================== METHODS
199 REM -----------------------------------------------------------------------------
200 Public Function CloseFile() As Boolean
201 ''' Empties the output buffer if relevant. Closes the actual input or output stream
202 ''' Args:
203 ''' Returns:
204 ''' True if the closure was successful
205 ''' Exceptions:
206 ''' FILENOTOPENERROR Nothing found to close
207 ''' Examples:
208 ''' myFile.CloseFile()
210 Dim bClose As Boolean ' Return value
212 Const cstSubArgs = ""
214 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
215 bClose = False
217 Check:
218 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
219 If Not _IsFileOpen() Then GoTo Finally
221 Try:
222 If Not IsNull(_InputStream) Then _InputStream.closeInput()
223 If Not IsNull(_OutputStream) Then
224 _OutputStream.flush()
225 _OutputStream.closeOutput()
226 End If
227 Set _InputStream = Nothing
228 Set _OutputStream = Nothing
229 Set _FileHandler = Nothing
230 bClose = True
232 Finally:
233 CloseFile = bClose
234 SF_Utils._ExitFunction(cstThisSub)
235 Exit Function
236 Catch:
237 GoTo Finally
238 End Function ' ScriptForge.SF_TextStream.CloseFile
240 REM -----------------------------------------------------------------------------
241 Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
242 ''' Return the actual value of the given property
243 ''' Args:
244 ''' PropertyName: the name of the property as a string
245 ''' Returns:
246 ''' The actual value of the property
247 ''' If the property does not exist, returns Null
248 ''' Exceptions:
249 ''' see the exceptions of the individual properties
250 ''' Examples:
254 Const cstSubArgs = ""
256 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
257 GetProperty = Null
259 Check:
260 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
261 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
262 End If
264 Try:
265 GetProperty = _PropertyGet(PropertyName)
267 Finally:
268 SF_Utils._ExitFunction(cstThisSub)
269 Exit Function
270 Catch:
271 GoTo Finally
272 End Function ' ScriptForge.SF_TextStream.GetProperty
274 REM -----------------------------------------------------------------------------
275 Public Function Methods() As Variant
276 ''' Return the list of public methods of the Model service as an array
278 Methods = Array( _
285 )
287 End Function ' ScriptForge.SF_TextStream.Methods
289 REM -----------------------------------------------------------------------------
290 Public Function Properties() As Variant
291 ''' Return the list or properties of the Timer class as an array
293 Properties = Array( _
300 )
302 End Function ' ScriptForge.SF_TextStream.Properties
304 REM -----------------------------------------------------------------------------
305 Public Function ReadAll() As String
306 ''' Returns all the remaining lines in the text stream as one string. Line breaks are NOT removed
307 ''' The resulting string can be split in lines
308 ''' either by using the usual Split Basic builtin function if the line delimiter is known
309 ''' or with the SF_String.SplitLines method
310 ''' For large files, using the ReadAll method wastes memory resources.
311 ''' Other techniques should be used to input a file, such as reading a file line-by-line
312 ''' Args:
313 ''' Returns:
314 ''' The read lines. The string may be empty.
316 ''' Exceptions:
317 ''' FILENOTOPENERROR File not open or already closed
318 ''' FILEOPENMODEERROR File opened in write or append modes
319 ''' ENDOFFILEERROR Previous reads already reached the end of the file
320 ''' Examples:
321 ''' Dim a As String
322 ''' a = myFile.ReadAll()
324 Dim sRead As String ' Return value
326 Const cstSubArgs = ""
328 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
329 sRead = ""
331 Check:
332 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
334 If _InputStream.isEOF() Then GoTo CatchEOF
335 End If
337 Try:
338 sRead = _InputStream.readString(Array(), False)
339 _LineNumber = _LineNumber + 1
341 Finally:
342 ReadAll = sRead
343 SF_Utils._ExitFunction(cstThisSub)
344 Exit Function
345 Catch:
346 GoTo Finally
347 CatchEOF:
348 SF_Exception.RaiseFatal(ENDOFFILEERROR, FileName)
349 GoTo Finally
350 End Function ' ScriptForge.SF_TextStream.ReadAll
352 REM -----------------------------------------------------------------------------
353 Public Function ReadLine() As String
354 ''' Returns the next line in the text stream as a string. Line breaks are removed.
355 ''' Args:
356 ''' Returns:
357 ''' The read line. The string may be empty.
358 ''' Exceptions:
359 ''' FILENOTOPENERROR File not open or already closed
360 ''' FILEOPENMODEERROR File opened in write or append modes
361 ''' ENDOFFILEERROR Previous reads already reached the end of the file
362 ''' Examples:
363 ''' Dim a As String
364 ''' a = myFile.ReadLine()
366 Dim sRead As String ' Return value
367 Dim iRead As Integer ' Length of line break
369 Const cstSubArgs = ""
371 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
372 sRead = ""
374 Check:
375 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
377 If AtEndOfStream Then GoTo CatchEOF
378 End If
380 Try:
381 ' When the text file ends with a line break,
382 ' XTextInputStream.readLine() returns the line break together with the last line
383 ' Hence the workaround to force a blank line at the end
384 If _ForceBlankLine Then
385 sRead = ""
386 _ForceBlankLine = False
387 Else
388 sRead = _InputStream.readLine()
389 ' The isEOF() is set immediately after having read the last line
391 iRead = 0
392 If SF_String.EndsWith(sRead, SF_String.sfCRLF) Then
393 iRead = 2
394 ElseIf SF_String.EndsWith(sRead, SF_String.sfLF) Or SF_String.EndsWith(sRead, SF_String.sfCR) Then
395 iRead = 1
396 End If
398 sRead = Left(sRead, Len(sRead) - iRead)
399 _ForceBlankLine = True ' Provision for a last empty line at the next read loop
400 End If
401 End If
402 End If
403 _LineNumber = _LineNumber + 1
405 Finally:
406 ReadLine = sRead
407 SF_Utils._ExitFunction(cstThisSub)
408 Exit Function
409 Catch:
410 GoTo Finally
411 CatchEOF:
412 SF_Exception.RaiseFatal(ENDOFFILEERROR, FileName)
413 GoTo Finally
414 End Function ' ScriptForge.SF_TextStream.ReadLine
416 REM -----------------------------------------------------------------------------
417 Public Function SetProperty(Optional ByVal PropertyName As Variant _
418 , Optional ByRef Value As Variant _
419 ) As Boolean
420 ''' Set a new value to the given property
421 ''' Args:
422 ''' PropertyName: the name of the property as a string
423 ''' Value: its new value
424 ''' Exceptions
425 ''' ARGUMENTERROR The property does not exist
427 Dim bSet As Boolean ' Return value
431 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
432 bSet = False
434 Check:
435 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
436 If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
437 End If
439 Try:
440 bSet = True
441 Select Case UCase(PropertyName)
444 NewLine = Value
445 Case Else
446 bSet = False
447 End Select
449 Finally:
450 SetProperty = bSet
451 SF_Utils._ExitFunction(cstThisSub)
452 Exit Function
453 Catch:
454 GoTo Finally
455 End Function ' ScriptForge.SF_TextStream.SetProperty
457 REM -----------------------------------------------------------------------------
458 Public Sub SkipLine()
459 ''' Skips the next line when reading a TextStream file.
460 ''' Args:
461 ''' Exceptions:
462 ''' FILENOTOPENERROR File not open or already closed
463 ''' FILEOPENMODEERROR File opened in write or append modes
464 ''' ENDOFFILEERROR Previous reads already reached the end of the file
465 ''' Examples:
466 ''' myFile.SkipLine()
468 Dim sRead As String ' Read buffer
470 Const cstSubArgs = ""
472 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
474 Check:
475 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
477 If Not _ForceBlankLine Then ' The file ends with a newline => return one empty line more
478 If _InputStream.isEOF() Then GoTo CatchEOF
479 End If
480 End If
482 Try:
483 sRead = ReadLine()
485 Finally:
486 SF_Utils._ExitFunction(cstThisSub)
487 Exit Sub
488 Catch:
489 GoTo Finally
490 CatchEOF:
491 SF_Exception.RaiseFatal(ENDOFFILEERROR, FileName)
492 GoTo Finally
493 End Sub ' ScriptForge.SF_TextStream.SkipLine
495 REM -----------------------------------------------------------------------------
496 Public Sub WriteBlankLines(Optional ByVal Lines As Variant)
497 ''' Writes a number of empty lines in the output stream
498 ''' Args:
499 ''' Lines: the number of lines to write
500 ''' Returns:
501 ''' Exceptions:
502 ''' FILENOTOPENERROR File not open or already closed
503 ''' FILEOPENMODEERROR File opened in read mode
504 ''' Examples:
506 Dim i As Long
510 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
512 Check:
513 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
516 End If
518 Try:
519 For i = 1 To Lines
520 _OutputStream.writeString(_NewLine)
521 Next i
522 _LineNumber = _LineNumber + Lines
524 Finally:
525 SF_Utils._ExitFunction(cstThisSub)
526 Exit Sub
527 Catch:
528 GoTo Finally
529 End Sub ' ScriptForge.SF_TextStream.WriteBlankLines
531 REM -----------------------------------------------------------------------------
532 Public Sub WriteLine(Optional ByVal Line As Variant)
533 ''' Writes the given line to the output stream. A newline is inserted if relevant
534 ''' Args:
535 ''' Line: the line to write, may be empty
536 ''' Returns:
537 ''' Exceptions:
538 ''' FILENOTOPENERROR File not open or already closed
539 ''' FILEOPENMODEERROR File opened in in read mode
540 ''' Examples:
542 Dim i As Long
546 If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
548 Check:
549 If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
552 End If
554 Try:
556 _LineNumber = _LineNumber + 1
558 Finally:
559 SF_Utils._ExitFunction(cstThisSub)
560 Exit Sub
561 Catch:
562 GoTo Finally
563 End Sub ' ScriptForge.SF_TextStream.WriteLine
565 REM =========================================================== PRIVATE FUNCTIONS
567 REM -----------------------------------------------------------------------------
568 Public Sub _Initialize()
569 ''' Opens file and setup input and/or output streams (ForAppending requires both)
571 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
573 ' Default newline related to current operating system
574 _NewLine = SF_String.sfNEWLINE
578 ' Setup input and/or output streams based on READ/WRITE/APPEND IO modes
579 Select Case _IOMode
580 Case SF_FileSystem.ForReading
581 Set _FileHandler = oSfa.openFileRead(_FileName)
583 _InputStream.setInputStream(_FileHandler)
584 Case SF_FileSystem.ForWriting
585 ' Output file is deleted beforehand
586 If _FileExists Then oSfa.kill(_FileName)
587 Set _FileHandler = oSfa.openFileWrite(_FileName)
589 _OutputStream.setOutputStream(_FileHandler)
590 Case SF_FileSystem.ForAppending
591 Set _FileHandler = oSfa.openFileReadWrite(_FileName)
594 _InputStream.setInputStream(_FileHandler)
595 ' Position at end of file: Skip and count existing lines
596 _LineNumber = 0
597 Do While Not _InputStream.isEOF()
598 _InputStream.readLine()
599 _LineNumber = _LineNumber + 1
600 Loop
601 _OutputStream.setOutputStream(_FileHandler)
602 End Select
605 If Not IsNull(_InputStream) Then _InputStream.setEncoding(_Encoding)
606 If Not IsNull(_OutputStream) Then _OutputStream.setEncoding(_Encoding)
608 End Sub ' ScriptForge.SF_TextStream._Initialize
610 REM -----------------------------------------------------------------------------
611 Private Function _IsFileOpen(Optional ByVal psMode As String) As Boolean
612 ''' Checks if file is open with the right mode (READ or WRITE)
613 ''' Raises an exception if the file is not open at all or not in the right mode
614 ''' Args:
615 ''' psMode: READ or WRITE or zero-length string
616 ''' Exceptions:
617 ''' FILENOTOPENERROR File not open or already closed
618 ''' FILEOPENMODEERROR File opened in incompatible mode
620 _IsFileOpen = False
621 If IsMissing(psMode) Then psMode = ""
622 If IsNull(_InputStream) And IsNull(_OutputStream) Then GoTo CatchNotOpen
623 Select Case psMode
625 If IsNull(_InputStream) Then GoTo CatchOpenMode
626 If _IOMode <> SF_FileSystem.ForReading Then GoTo CatchOpenMode
628 If IsNull(_OutputStream) Then GoTo CatchOpenMode
629 If _IOMode = SF_FileSystem.ForReading Then GoTo CatchOpenMode
630 Case Else
631 End Select
632 _IsFileOpen = True
634 Finally:
635 Exit Function
636 CatchNotOpen:
637 SF_Exception.RaiseFatal(FILENOTOPENERROR, FileName)
638 GoTo Finally
639 CatchOpenMode:
640 SF_Exception.RaiseFatal(FILEOPENMODEERROR, FileName, IOMode)
641 GoTo Finally
642 End Function ' ScriptForge.SF_TextStream._IsFileOpen
644 REM -----------------------------------------------------------------------------
645 Private Function _PropertyGet(Optional ByVal psProperty As String)
646 ''' Return the value of the named property
647 ''' Args:
648 ''' psProperty: the name of the property
650 Dim cstThisSub As String
651 Dim cstSubArgs As String
654 cstSubArgs = ""
655 SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
657 Select Case UCase(psProperty)
659 Select Case _IOMode
660 Case SF_FileSystem.ForReading
661 If IsNull(_InputStream) Then _PropertyGet = True Else _PropertyGet = CBool(_InputStream.isEOF() And Not _ForceBlankLine)
662 Case Else : _PropertyGet = True
663 End Select
665 _PropertyGet = _Encoding
667 _PropertyGet = SF_FileSystem._ConvertFromUrl(_FileName) ' Depends on FileNaming
669 With SF_FileSystem
670 Select Case _IOMode
674 Case Else : _PropertyGet = ""
675 End Select
676 End With
678 _PropertyGet = _LineNumber
680 _PropertyGet = _NewLine
681 Case Else
682 _PropertyGet = Null
683 End Select
685 Finally:
686 SF_Utils._ExitFunction(cstThisSub)
687 Exit Function
688 End Function ' ScriptForge.SF_TextStream._PropertyGet
690 REM -----------------------------------------------------------------------------
691 Private Function _Repr() As String
692 ''' Convert the TextStream instance to a readable string, typically for debugging purposes (DebugPrint ...)
693 ''' Args:
694 ''' Return:
697 _Repr = "[TextStream]: " & FileName & "," & IOMode & "," & CStr(Line)
699 End Function ' ScriptForge.SF_TextStream._Repr
701 REM ============================================ END OF SCRIPTFORGE.SF_TextStream
702 </script:module>