Skip to content

Commit ede574d

Browse files
committed
Bug fixes and performance improvements
The class was not able to handle lines with more characters than the buffer. Streams ending in line breaks are 2 times faster than the previous version.
1 parent a9ed4bd commit ede574d

File tree

1 file changed

+92
-57
lines changed

1 file changed

+92
-57
lines changed

src/ECPTextStream.cls

Lines changed: 92 additions & 57 deletions
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,7 @@ Option Explicit
2626
Private Const DualLFchar As String = vbLf & vbLf
2727
Private Const InverseCRLF As String = vbLf & vbCr
2828
Private Const SizeFactor As Long = 524288
29+
Private Const WhiteSpace As String = " "
2930
'////////////////////////////////////////////////////////////////////////////////////////////
3031
'#
3132
'////////////////////////////////////////////////////////////////////////////////////////////
@@ -45,10 +46,13 @@ Private P_TEXT As String '-------------------------Holds the current stream's te
4546
'////////////////////////////////////////////////////////////////////////////////////////////
4647
' VARIABLES:
4748
' @Common
49+
Private Last2Chrs As String
50+
Private LastChr As String
4851
'////////////////////////////////////////////////////////////////////////////////////////////
4952
'#
5053
Private Buffer As String
5154
Private BufferDelta As Long
55+
Private BufferEnds As Boolean
5256
Private BufferMark As Long
5357
Private CorrectedPos As Long
5458
Private EndLineMark As EndLineChar
@@ -57,6 +61,7 @@ Private InitialPos As Long
5761
Private LCS As Long
5862
Private NullChar As String
5963
Private NullCharPos As Long
64+
Private TmpInitialPos As Long
6065
'////////////////////////////////////////////////////////////////////////////////////////////
6166
'#
6267
'////////////////////////////////////////////////////////////////////////////////////////////
@@ -103,9 +108,9 @@ End Property
103108
Public Property Get isOpenStream() As Boolean
104109
isOpenStream = P_ISOPENSTREAM
105110
End Property
106-
Public Property Get LineBreak() As String
107-
Attribute LineBreak.VB_Description = "Returns the character used to end the last received stream. The value is vbNullString when the last stream is not forced to end on line break."
108-
LineBreak = P_LINEBREAK
111+
Public Property Get lineBreak() As String
112+
Attribute lineBreak.VB_Description = "Returns the character used to end the last received stream. The value is vbNullString when the last stream is not forced to end on line break."
113+
lineBreak = P_LINEBREAK
109114
End Property
110115
Public Property Get pointerPosition() As Long
111116
Attribute pointerPosition.VB_Description = "Gets the overall pointer position over the current text file."
@@ -120,6 +125,7 @@ Attribute streamLength.VB_Description = "Gets the current opened file
120125
streamLength = P_STREAMLENGTH
121126
End Property
122127
Public Property Get unifiedLFOutput() As Boolean
128+
Attribute unifiedLFOutput.VB_Description = "Determines whether the buffer string is returned using only the LF character as a linefeed."
123129
unifiedLFOutput = P_UNIFIEDLFOUTPUT
124130
End Property
125131
Public Property Let unifiedLFOutput(value As Boolean)
@@ -136,70 +142,97 @@ Attribute CloseStream.VB_Description = "Closes the current text file stream."
136142
P_ISOPENSTREAM = False
137143
End If
138144
End Sub
145+
Private Sub DoubleBufferSize()
146+
Dim LCSt As Long
147+
P_BUFFERSIZE = 2 * P_BUFFERSIZE
148+
P_BUFFERLENGTH = CLng(P_BUFFERSIZE * SizeFactor)
149+
LCSt = P_STREAMLENGTH - P_BUFFERLENGTH
150+
Select Case LCSt
151+
Case Is > 0
152+
Buffer = SPACE$(P_BUFFERLENGTH)
153+
Case Else
154+
Buffer = SPACE$(P_STREAMLENGTH)
155+
End Select
156+
End Sub
139157
Private Sub FindEOLcharacter()
140-
Dim LastCrLfPos As Long
141-
Dim LastCrPos As Long
142-
Dim LastLfPos As Long
143-
Dim tmpResultPos As Long
144-
Dim bufferReverse As String
158+
Dim CrCharInStream As Boolean
159+
Dim LfCharInStream As Boolean
145160
Dim EOLchr As EndLineChar
146161
Dim missingEOLchar As Boolean
147162
Dim EOStream As Boolean
148-
Dim tmpBuffer As String
149163

150164
Do
151-
bufferReverse = StrReverse(Buffer)
152-
LastCrLfPos = InStrB(1, bufferReverse, InverseCRLF)
153-
If LastCrLfPos Then LastCrLfPos = LastCrLfPos + 2
154-
LastCrPos = InStrB(1, bufferReverse, vbCr)
155-
LastLfPos = InStrB(1, bufferReverse, vbLf)
156-
missingEOLchar = (LastCrLfPos = 0 And LastCrPos = 0 And LastLfPos = 0)
165+
CrCharInStream = InStrB(1, Buffer, vbCr)
166+
LfCharInStream = InStrB(1, Buffer, vbLf)
167+
missingEOLchar = (Not CrCharInStream) And (Not LfCharInStream)
157168
If missingEOLchar Then
158-
tmpBuffer = Buffer
169+
DoubleBufferSize
170+
SeekPointer TmpInitialPos
159171
Get #FileHandled, , Buffer
160-
Buffer = tmpBuffer + Buffer
161172
InitialPos = Seek(FileHandled)
162173
BufferMark = LenB(Buffer)
163-
EOStream = ((P_STREAMLENGTH - InitialPos) <= 0)
164-
If EOStream Then
165-
NullCharPos = InStrB(Buffer, NullChar)
166-
If NullCharPos Then
167-
Buffer = MidB$(Buffer, 1, NullCharPos)
168-
End If
169-
End If
174+
EOStream = (P_STREAMLENGTH <= InitialPos)
170175
End If
171176
Loop While missingEOLchar And Not EOStream
172177
P_ATENDOFSTREAM = EOStream
173178
If Not EOStream Then
174-
tmpResultPos = LastCrLfPos
175-
EOLchr = CRLF
176-
If tmpResultPos < LastCrPos Then
177-
tmpResultPos = LastCrPos
178-
EOLchr = CR
179-
End If
180-
If tmpResultPos < LastLfPos Then
181-
tmpResultPos = LastLfPos
182-
EOLchr = LF
179+
If Not missingEOLchar Then
180+
Last2Chrs = MidB$(Buffer, BufferMark - 3, 4)
181+
BufferEnds = (Last2Chrs = vbCrLf)
182+
Select Case BufferEnds
183+
Case False
184+
LastChr = MidB$(Last2Chrs, 3, 2)
185+
BufferEnds = (LastChr = vbCr)
186+
Select Case BufferEnds
187+
Case False
188+
BufferEnds = (LastChr = vbLf)
189+
If BufferEnds Then
190+
P_LINEBREAK = vbLf
191+
Else
192+
GoBackToLineBreak
193+
End If
194+
Case Else
195+
P_LINEBREAK = vbCr
196+
End Select
197+
Case Else
198+
P_LINEBREAK = vbCrLf
199+
End Select
183200
End If
184-
Select Case EOLchr
185-
Case 0
186-
BufferDelta = tmpResultPos - 3
187-
P_LINEBREAK = vbCrLf
188-
Case Else
189-
BufferDelta = tmpResultPos - 1
190-
If EOLchr = 1 Then
191-
P_LINEBREAK = vbCr
192-
Else
193-
P_LINEBREAK = vbLf
194-
End If
195-
End Select
196-
BufferMark = BufferMark - BufferDelta
197-
CorrectedPos = InitialPos - (BufferDelta / 2)
201+
CorrectedPos = InitialPos - BufferDelta
202+
BufferDelta = 0
198203
Else
199-
CorrectedPos = InitialPos
204+
NullCharPos = InStrB(Buffer, NullChar)
205+
If NullCharPos Then
206+
BufferMark = NullCharPos
207+
End If
208+
CorrectedPos = P_STREAMLENGTH + 1
200209
End If
201210
Seek #FileHandled, CorrectedPos
202211
End Sub
212+
Private Sub GoBackToLineBreak()
213+
Do
214+
BufferMark = BufferMark - 2
215+
BufferDelta = BufferDelta + 1
216+
Last2Chrs = MidB$(Buffer, BufferMark - 3, 4)
217+
BufferEnds = (Last2Chrs = vbCrLf)
218+
Select Case BufferEnds
219+
Case False
220+
LastChr = MidB$(Last2Chrs, 3, 2)
221+
BufferEnds = (LastChr = vbCr)
222+
Select Case BufferEnds
223+
Case False
224+
BufferEnds = (LastChr = vbLf)
225+
If BufferEnds Then
226+
P_LINEBREAK = vbLf
227+
End If
228+
Case Else
229+
P_LINEBREAK = vbCr
230+
End Select
231+
Case Else
232+
P_LINEBREAK = vbCrLf
233+
End Select
234+
Loop While Not BufferEnds
235+
End Sub
203236
Private Sub NormalizeLineBreaks()
204237
If InStrB(1, P_TEXT, vbCr, vbBinaryCompare) Then
205238
P_TEXT = Replace(P_TEXT, vbCr, vbLf, 1)
@@ -209,20 +242,22 @@ Private Sub NormalizeLineBreaks()
209242
Loop
210243
P_LINEBREAK = vbLf
211244
End Sub
212-
Public Sub OpenStream(filePath As String)
245+
Public Sub OpenStream(FilePath As String)
213246
Attribute OpenStream.VB_Description = "Opens a stream over a text file."
214247
FileHandled = FreeFile
215-
Open filePath For Binary As #FileHandled
248+
Open FilePath For Binary As #FileHandled
216249
P_ISOPENSTREAM = True
217250
P_STREAMLENGTH = LOF(FileHandled)
218251
StartVariables
219252
End Sub
220253
Public Sub ReadText()
221254
Attribute ReadText.VB_Description = "Reads a number of characters from the stream file and saves the result to the current instance."
222255
If Not P_ATENDOFSTREAM And P_ISOPENSTREAM Then
256+
If InitialPos = 0 Then InitialPos = 1
223257
Select Case P_BUFFERLENGTH
224258
Case Is < LCS
225259
BufferDelta = 0
260+
TmpInitialPos = InitialPos
226261
Get #FileHandled, , Buffer
227262
InitialPos = Seek(FileHandled)
228263
BufferMark = LenB(Buffer)
@@ -278,20 +313,20 @@ End Sub
278313
Public Sub WriteBlankLines(Lines As Long, Optional EndLineMark As EndLineChar = 0)
279314
Attribute WriteBlankLines.VB_Description = "Inserts a specified number of blank lines into the current opened text file."
280315
If P_ISOPENSTREAM Then
281-
Dim Idx As Long
316+
Dim idx As Long
282317
Select Case EndLineMark
283318
Case 0
284-
For Idx = 1 To Lines
319+
For idx = 1 To Lines
285320
Put #FileHandled, , vbCrLf
286-
Next Idx
321+
Next idx
287322
Case 1
288-
For Idx = 1 To Lines
323+
For idx = 1 To Lines
289324
Put #FileHandled, , vbCr
290-
Next Idx
325+
Next idx
291326
Case 2
292-
For Idx = 1 To Lines
327+
For idx = 1 To Lines
293328
Put #FileHandled, , vbLf
294-
Next Idx
329+
Next idx
295330
End Select
296331
P_STREAMLENGTH = LOF(FileHandled)
297332
End If

0 commit comments

Comments
 (0)