REM ======================================================================================================================= REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === REM === Full documentation is available on https://help.libreoffice.org/ === REM ======================================================================================================================= Option Compatible Option ClassModule Option Explicit ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''' SF_TextStream ''' ============= ''' Class instantiated by the ''' SF_FileSystem.CreateTextFile ''' SF_FileSystem.OpenTextFile ''' methods to facilitate the sequential processing of text files ''' All open/read/write/close operations are presumed to happen during the same macro run ''' The encoding to be used may be chosen by the user ''' The list is in the Name column of https://www.iana.org/assignments/character-sets/character-sets.xhtml ''' Note that probably not all values are available ''' Line delimiters may be chosen by the user ''' In input, CR, LF or CR+LF are supported ''' In output, the default value is the usual newline on the actual operating system (see SF_FileSystem.sfNEWLINE) ''' ''' The design choices are largely inspired by ''' https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/textstream-object ''' The implementation is mainly based on the XTextInputStream and XTextOutputStream UNO interfaces ''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1io_1_1XTextInputStream.html ''' https://api.libreoffice.org/docs/idl/ref/interfacecom_1_1sun_1_1star_1_1io_1_1XTextOutputStream.html ''' ''' Instantiation example: ''' Dim FSO As Object, myFile As Object ''' Set FSO = CreateScriptService("FileSystem") ''' Set myFile = FSO.OpenTextFile("C:\Temp\ThisFile.txt", FSO.ForReading) ' Once per file ''' ''' Detailed user documentation: ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_textstream.html?DbPAR=BASIC ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' REM ================================================================== EXCEPTIONS Const FILENOTOPENERROR = "FILENOTOPENERROR" ' The file is already closed Const FILEOPENMODEERROR = "FILEOPENMODEERROR" ' The file is open in incompatible mode Const ENDOFFILEERROR = "ENDOFFILEERROR" ' When file was read, an end-of-file was encountered REM ============================================================= PRIVATE MEMBERS Private [Me] As Object Private [_Parent] As Object Private ObjectType As String ' Must be TEXTSTREAM Private ServiceName As String Private _FileName As String ' File where it is about Private _IOMode As Integer ' ForReading, ForWriting or ForAppending Private _Encoding As String ' https://www.iana.org/assignments/character-sets/character-sets.xhtml Private _NewLine As String ' Line break in write mode Private _FileExists As Boolean ' True if file exists before open Private _LineNumber As Long ' Number of lines read or written Private _FileHandler As Object ' com.sun.star.io.XInputStream or ' com.sun.star.io.XOutputStream or ' com.sun.star.io.XStream Private _InputStream As Object ' com.sun.star.io.TextInputStream Private _OutputStream As Object ' com.sun.star.io.TextOutputStream Private _ForceBlankLine As Boolean ' Workaround: XTextInputStream misses last line if file ends with newline REM ============================================================ MODULE CONSTANTS REM ===================================================== CONSTRUCTOR/DESTRUCTOR REM ----------------------------------------------------------------------------- Private Sub Class_Initialize() Set [Me] = Nothing Set [_Parent] = Nothing ObjectType = "TEXTSTREAM" ServiceName = "ScriptForge.TextStream" _FileName = "" _IOMode = -1 _Encoding = "" _NewLine = "" _FileExists = False _LineNumber = 0 Set _FileHandler = Nothing Set _InputStream = Nothing Set _OutputStream = Nothing _ForceBlankLine = False End Sub ' ScriptForge.SF_TextStream Constructor REM ----------------------------------------------------------------------------- Private Sub Class_Terminate() Call Class_Initialize() End Sub ' ScriptForge.SF_TextStream Destructor REM ----------------------------------------------------------------------------- Public Function Dispose() As Variant Call Class_Terminate() Set Dispose = Nothing End Function ' ScriptForge.SF_TextStream Explicit Destructor REM ================================================================== PROPERTIES REM ----------------------------------------------------------------------------- Property Get AtEndOfStream() As Boolean ''' In reading mode, True indicates that the end of the file has been reached ''' In write and append modes, or if the file is not ready => always True ''' The property should be invoked BEFORE each ReadLine() method: ''' A ReadLine() executed while AtEndOfStream is True will raise an error ''' Example: ''' Dim sLine As String ''' Do While Not myFile.AtEndOfStream ''' sLine = myFile.ReadLine() ''' ' ... ''' Loop AtEndOfStream = _PropertyGet("AtEndOfStream") End Property ' ScriptForge.SF_TextStream.AtEndOfStream REM ----------------------------------------------------------------------------- Property Get Encoding() As String ''' Returns the name of the text file either in url or in native operating system format ''' Example: ''' Dim myFile As Object ''' FSO.FileNaming = "SYS" ''' Set myFile = FSO.OpenTextFile("C:\Temp\myFile.txt") ''' MsgBox myFile.Encoding ' UTF-8 Encoding = _PropertyGet("Encoding") End Property ' ScriptForge.SF_TextStream.Encoding REM ----------------------------------------------------------------------------- Property Get FileName() As String ''' Returns the name of the text file either in url or in native operating system format ''' Example: ''' Dim myFile As Object ''' FSO.FileNaming = "SYS" ''' Set myFile = FSO.OpenTextFile("C:\Temp\myFile.txt") ''' MsgBox myFile.FileName ' C:\Temp\myFile.txt FileName = _PropertyGet("FileName") End Property ' ScriptForge.SF_TextStream.FileName REM ----------------------------------------------------------------------------- Property Get IOMode() As String ''' Returns either "READ", "WRITE" or "APPEND" ''' Example: ''' Dim myFile As Object ''' FSO.FileNaming = "SYS" ''' Set myFile = FSO.OpenTextFile("C:\Temp\myFile.txt") ''' MsgBox myFile.IOMode ' READ IOMode = _PropertyGet("IOMode") End Property ' ScriptForge.SF_TextStream.IOMode REM ----------------------------------------------------------------------------- Property Get Line() As Long ''' Returns the number of lines read or written so far ''' Example: ''' Dim myFile As Object ''' FSO.FileNaming = "SYS" ''' Set myFile = FSO.OpenTextFile("C:\Temp\myFile.txt", FSO.ForAppending) ''' MsgBox myFile.Line ' The number of lines already present in myFile Line = _PropertyGet("Line") End Property ' ScriptForge.SF_TextStream.Line REM ----------------------------------------------------------------------------- Property Get NewLine() As Variant ''' Returns the current character string to be inserted between 2 successive written lines ''' The default value is the native line separator in the current operating system ''' Example: ''' MsgBox myFile.NewLine NewLine = _PropertyGet("NewLine") End Property ' ScriptForge.SF_TextStream.NewLine (get) REM ----------------------------------------------------------------------------- Property Let NewLine(ByVal pvLineBreak As Variant) ''' Sets the current character string to be inserted between 2 successive written lines ''' Example: ''' myFile.NewLine = Chr(13) & Chr(10) Const cstThisSub = "TextStream.setNewLine" SF_Utils._EnterFunction(cstThisSub) If VarType(pvLineBreak) = V_STRING Then _NewLine = pvLineBreak SF_Utils._ExitFunction(cstThisSub) End Property ' ScriptForge.SF_TextStream.NewLine (let) REM ===================================================================== METHODS REM ----------------------------------------------------------------------------- Public Function CloseFile() As Boolean ''' Empties the output buffer if relevant. Closes the actual input or output stream ''' Args: ''' Returns: ''' True if the closure was successful ''' Exceptions: ''' FILENOTOPENERROR Nothing found to close ''' Examples: ''' myFile.CloseFile() Dim bClose As Boolean ' Return value Const cstThisSub = "TextStream.CloseFile" Const cstSubArgs = "" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bClose = False Check: SF_Utils._EnterFunction(cstThisSub, cstSubArgs) If Not _IsFileOpen() Then GoTo Finally Try: If Not IsNull(_InputStream) Then _InputStream.closeInput() If Not IsNull(_OutputStream) Then _OutputStream.flush() _OutputStream.closeOutput() End If Set _InputStream = Nothing Set _OutputStream = Nothing Set _FileHandler = Nothing bClose = True Finally: CloseFile = bClose SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_TextStream.CloseFile REM ----------------------------------------------------------------------------- Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant ''' Return the actual value of the given property ''' Args: ''' PropertyName: the name of the property as a string ''' Returns: ''' The actual value of the property ''' If the property does not exist, returns Null ''' Exceptions: ''' see the exceptions of the individual properties ''' Examples: ''' myModel.GetProperty("MyProperty") Const cstThisSub = "TextStream.GetProperty" Const cstSubArgs = "" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch GetProperty = Null Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch End If Try: GetProperty = _PropertyGet(PropertyName) Finally: SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_TextStream.GetProperty REM ----------------------------------------------------------------------------- Public Function Methods() As Variant ''' Return the list of public methods of the Model service as an array Methods = Array( _ "CloseFile" _ , "ReadAll" _ , "readLine" _ , "SkipLine" _ , "WriteBlankLines" _ , "WriteLine" _ ) End Function ' ScriptForge.SF_TextStream.Methods REM ----------------------------------------------------------------------------- Public Function Properties() As Variant ''' Return the list or properties of the Timer class as an array Properties = Array( _ "AtEndOfStream" _ , "Encoding" _ , "FileName" _ , "IOMode" _ , "Line" _ , "NewLine" _ ) End Function ' ScriptForge.SF_TextStream.Properties REM ----------------------------------------------------------------------------- Public Function ReadAll() As String ''' Returns all the remaining lines in the text stream as one string. Line breaks are NOT removed ''' The resulting string can be split in lines ''' either by using the usual Split Basic builtin function if the line delimiter is known ''' or with the SF_String.SplitLines method ''' For large files, using the ReadAll method wastes memory resources. ''' Other techniques should be used to input a file, such as reading a file line-by-line ''' Args: ''' Returns: ''' The read lines. The string may be empty. ''' Note that the Line property in incremented only by 1 ''' Exceptions: ''' FILENOTOPENERROR File not open or already closed ''' FILEOPENMODEERROR File opened in write or append modes ''' ENDOFFILEERROR Previous reads already reached the end of the file ''' Examples: ''' Dim a As String ''' a = myFile.ReadAll() Dim sRead As String ' Return value Const cstThisSub = "TextStream.ReadAll" Const cstSubArgs = "" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch sRead = "" Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsFileOpen("READ") Then GoTo Finally If _InputStream.isEOF() Then GoTo CatchEOF End If Try: sRead = _InputStream.readString(Array(), False) _LineNumber = _LineNumber + 1 Finally: ReadAll = sRead SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally CatchEOF: SF_Exception.RaiseFatal(ENDOFFILEERROR, FileName) GoTo Finally End Function ' ScriptForge.SF_TextStream.ReadAll REM ----------------------------------------------------------------------------- Public Function ReadLine() As String ''' Returns the next line in the text stream as a string. Line breaks are removed. ''' Args: ''' Returns: ''' The read line. The string may be empty. ''' Exceptions: ''' FILENOTOPENERROR File not open or already closed ''' FILEOPENMODEERROR File opened in write or append modes ''' ENDOFFILEERROR Previous reads already reached the end of the file ''' Examples: ''' Dim a As String ''' a = myFile.ReadLine() Dim sRead As String ' Return value Dim iRead As Integer ' Length of line break Const cstThisSub = "TextStream.ReadLine" Const cstSubArgs = "" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch sRead = "" Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsFileOpen("READ") Then GoTo Finally If AtEndOfStream Then GoTo CatchEOF End If Try: ' When the text file ends with a line break, ' XTextInputStream.readLine() returns the line break together with the last line ' Hence the workaround to force a blank line at the end If _ForceBlankLine Then sRead = "" _ForceBlankLine = False Else sRead = _InputStream.readLine() ' The isEOF() is set immediately after having read the last line If _InputStream.isEOF() And Len(sRead) > 0 Then iRead = 0 If SF_String.EndsWith(sRead, SF_String.sfCRLF) Then iRead = 2 ElseIf SF_String.EndsWith(sRead, SF_String.sfLF) Or SF_String.EndsWith(sRead, SF_String.sfCR) Then iRead = 1 End If If iRead > 0 Then sRead = Left(sRead, Len(sRead) - iRead) _ForceBlankLine = True ' Provision for a last empty line at the next read loop End If End If End If _LineNumber = _LineNumber + 1 Finally: ReadLine = sRead SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally CatchEOF: SF_Exception.RaiseFatal(ENDOFFILEERROR, FileName) GoTo Finally End Function ' ScriptForge.SF_TextStream.ReadLine REM ----------------------------------------------------------------------------- Public Function SetProperty(Optional ByVal PropertyName As Variant _ , Optional ByRef Value As Variant _ ) As Boolean ''' Set a new value to the given property ''' Args: ''' PropertyName: the name of the property as a string ''' Value: its new value ''' Exceptions ''' ARGUMENTERROR The property does not exist Dim bSet As Boolean ' Return value Const cstThisSub = "TextStream.SetProperty" Const cstSubArgs = "PropertyName, Value" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bSet = False Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch End If Try: bSet = True Select Case UCase(PropertyName) Case "NEWLINE" If Not SF_Utils._Validate(Value, "Value", V_STRING) Then GoTo Catch NewLine = Value Case Else bSet = False End Select Finally: SetProperty = bSet SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' ScriptForge.SF_TextStream.SetProperty REM ----------------------------------------------------------------------------- Public Sub SkipLine() ''' Skips the next line when reading a TextStream file. ''' Args: ''' Exceptions: ''' FILENOTOPENERROR File not open or already closed ''' FILEOPENMODEERROR File opened in write or append modes ''' ENDOFFILEERROR Previous reads already reached the end of the file ''' Examples: ''' myFile.SkipLine() Dim sRead As String ' Read buffer Const cstThisSub = "TextStream.SkipLine" Const cstSubArgs = "" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsFileOpen("READ") Then GoTo Finally If Not _ForceBlankLine Then ' The file ends with a newline => return one empty line more If _InputStream.isEOF() Then GoTo CatchEOF End If End If Try: sRead = ReadLine() Finally: SF_Utils._ExitFunction(cstThisSub) Exit Sub Catch: GoTo Finally CatchEOF: SF_Exception.RaiseFatal(ENDOFFILEERROR, FileName) GoTo Finally End Sub ' ScriptForge.SF_TextStream.SkipLine REM ----------------------------------------------------------------------------- Public Sub WriteBlankLines(Optional ByVal Lines As Variant) ''' Writes a number of empty lines in the output stream ''' Args: ''' Lines: the number of lines to write ''' Returns: ''' Exceptions: ''' FILENOTOPENERROR File not open or already closed ''' FILEOPENMODEERROR File opened in read mode ''' Examples: ''' myFile.WriteBlankLines(10) Dim i As Long Const cstThisSub = "TextStream.WriteBlankLines" Const cstSubArgs = "Lines" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsFileOpen("WRITE") Then GoTo Finally If Not SF_Utils._Validate(Lines, "Lines", V_NUMERIC) Then GoTo Finally End If Try: For i = 1 To Lines _OutputStream.writeString(_NewLine) Next i _LineNumber = _LineNumber + Lines Finally: SF_Utils._ExitFunction(cstThisSub) Exit Sub Catch: GoTo Finally End Sub ' ScriptForge.SF_TextStream.WriteBlankLines REM ----------------------------------------------------------------------------- Public Sub WriteLine(Optional ByVal Line As Variant) ''' Writes the given line to the output stream. A newline is inserted if relevant ''' Args: ''' Line: the line to write, may be empty ''' Returns: ''' Exceptions: ''' FILENOTOPENERROR File not open or already closed ''' FILEOPENMODEERROR File opened in in read mode ''' Examples: ''' myFile.WriteLine("Next line") Dim i As Long Const cstThisSub = "TextStream.WriteLine" Const cstSubArgs = "Line" If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Check: If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsFileOpen("WRITE") Then GoTo Finally If Not SF_Utils._Validate(Line, "Line", V_STRING) Then GoTo Finally End If Try: _OutputStream.writeString(Iif(_LineNumber > 0, _NewLine, "") & Line) _LineNumber = _LineNumber + 1 Finally: SF_Utils._ExitFunction(cstThisSub) Exit Sub Catch: GoTo Finally End Sub ' ScriptForge.SF_TextStream.WriteLine REM =========================================================== PRIVATE FUNCTIONS REM ----------------------------------------------------------------------------- Public Sub _Initialize() ''' Opens file and setup input and/or output streams (ForAppending requires both) Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess ' Default newline related to current operating system _NewLine = SF_String.sfNEWLINE Set oSfa = SF_Utils._GetUNOService("FileAccess") ' Setup input and/or output streams based on READ/WRITE/APPEND IO modes Select Case _IOMode Case SF_FileSystem.ForReading Set _FileHandler = oSfa.openFileRead(_FileName) Set _InputStream = CreateUnoService("com.sun.star.io.TextInputStream") _InputStream.setInputStream(_FileHandler) Case SF_FileSystem.ForWriting ' Output file is deleted beforehand If _FileExists Then oSfa.kill(_FileName) Set _FileHandler = oSfa.openFileWrite(_FileName) Set _OutputStream = CreateUnoService("com.sun.star.io.TextOutputStream") _OutputStream.setOutputStream(_FileHandler) Case SF_FileSystem.ForAppending Set _FileHandler = oSfa.openFileReadWrite(_FileName) Set _InputStream = CreateUnoService("com.sun.star.io.TextInputStream") Set _OutputStream = CreateUnoService("com.sun.star.io.TextOutputStream") _InputStream.setInputStream(_FileHandler) ' Position at end of file: Skip and count existing lines _LineNumber = 0 Do While Not _InputStream.isEOF() _InputStream.readLine() _LineNumber = _LineNumber + 1 Loop _OutputStream.setOutputStream(_FileHandler) End Select If _Encoding = "" Then _Encoding = "UTF-8" If Not IsNull(_InputStream) Then _InputStream.setEncoding(_Encoding) If Not IsNull(_OutputStream) Then _OutputStream.setEncoding(_Encoding) End Sub ' ScriptForge.SF_TextStream._Initialize REM ----------------------------------------------------------------------------- Private Function _IsFileOpen(Optional ByVal psMode As String) As Boolean ''' Checks if file is open with the right mode (READ or WRITE) ''' Raises an exception if the file is not open at all or not in the right mode ''' Args: ''' psMode: READ or WRITE or zero-length string ''' Exceptions: ''' FILENOTOPENERROR File not open or already closed ''' FILEOPENMODEERROR File opened in incompatible mode _IsFileOpen = False If IsMissing(psMode) Then psMode = "" If IsNull(_InputStream) And IsNull(_OutputStream) Then GoTo CatchNotOpen Select Case psMode Case "READ" If IsNull(_InputStream) Then GoTo CatchOpenMode If _IOMode <> SF_FileSystem.ForReading Then GoTo CatchOpenMode Case "WRITE" If IsNull(_OutputStream) Then GoTo CatchOpenMode If _IOMode = SF_FileSystem.ForReading Then GoTo CatchOpenMode Case Else End Select _IsFileOpen = True Finally: Exit Function CatchNotOpen: SF_Exception.RaiseFatal(FILENOTOPENERROR, FileName) GoTo Finally CatchOpenMode: SF_Exception.RaiseFatal(FILEOPENMODEERROR, FileName, IOMode) GoTo Finally End Function ' ScriptForge.SF_TextStream._IsFileOpen REM ----------------------------------------------------------------------------- Private Function _PropertyGet(Optional ByVal psProperty As String) ''' Return the value of the named property ''' Args: ''' psProperty: the name of the property Dim cstThisSub As String Dim cstSubArgs As String cstThisSub = "TextStream.get" & psProperty cstSubArgs = "" SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Select Case UCase(psProperty) Case UCase("AtEndOfStream") Select Case _IOMode Case SF_FileSystem.ForReading If IsNull(_InputStream) Then _PropertyGet = True Else _PropertyGet = CBool(_InputStream.isEOF() And Not _ForceBlankLine) Case Else : _PropertyGet = True End Select Case UCase("Encoding") _PropertyGet = _Encoding Case UCase("FileName") _PropertyGet = SF_FileSystem._ConvertFromUrl(_FileName) ' Depends on FileNaming Case UCase("IOMode") With SF_FileSystem Select Case _IOMode Case .ForReading : _PropertyGet = "READ" Case .ForWriting : _PropertyGet = "WRITE" Case .ForAppending : _PropertyGet = "APPEND" Case Else : _PropertyGet = "" End Select End With Case UCase("Line") _PropertyGet = _LineNumber Case UCase("NewLine") _PropertyGet = _NewLine Case Else _PropertyGet = Null End Select Finally: SF_Utils._ExitFunction(cstThisSub) Exit Function End Function ' ScriptForge.SF_TextStream._PropertyGet REM ----------------------------------------------------------------------------- Private Function _Repr() As String ''' Convert the TextStream instance to a readable string, typically for debugging purposes (DebugPrint ...) ''' Args: ''' Return: ''' "[TextStream]: File name, IOMode, LineNumber" _Repr = "[TextStream]: " & FileName & "," & IOMode & "," & CStr(Line) End Function ' ScriptForge.SF_TextStream._Repr REM ============================================ END OF SCRIPTFORGE.SF_TextStream