@@ -26,6 +26,7 @@ Option Explicit
26
26
Private Const DualLFchar As String = vbLf & vbLf
27
27
Private Const InverseCRLF As String = vbLf & vbCr
28
28
Private Const SizeFactor As Long = 524288
29
+ Private Const WhiteSpace As String = " "
29
30
'////////////////////////////////////////////////////////////////////////////////////////////
30
31
'#
31
32
'////////////////////////////////////////////////////////////////////////////////////////////
@@ -45,10 +46,13 @@ Private P_TEXT As String '-------------------------Holds the current stream's te
45
46
'////////////////////////////////////////////////////////////////////////////////////////////
46
47
' VARIABLES:
47
48
' @Common
49
+ Private Last2Chrs As String
50
+ Private LastChr As String
48
51
'////////////////////////////////////////////////////////////////////////////////////////////
49
52
'#
50
53
Private Buffer As String
51
54
Private BufferDelta As Long
55
+ Private BufferEnds As Boolean
52
56
Private BufferMark As Long
53
57
Private CorrectedPos As Long
54
58
Private EndLineMark As EndLineChar
@@ -57,6 +61,7 @@ Private InitialPos As Long
57
61
Private LCS As Long
58
62
Private NullChar As String
59
63
Private NullCharPos As Long
64
+ Private TmpInitialPos As Long
60
65
'////////////////////////////////////////////////////////////////////////////////////////////
61
66
'#
62
67
'////////////////////////////////////////////////////////////////////////////////////////////
@@ -103,9 +108,9 @@ End Property
103
108
Public Property Get isOpenStream() As Boolean
104
109
isOpenStream = P_ISOPENSTREAM
105
110
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
109
114
End Property
110
115
Public Property Get pointerPosition() As Long
111
116
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
120
125
streamLength = P_STREAMLENGTH
121
126
End Property
122
127
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."
123
129
unifiedLFOutput = P_UNIFIEDLFOUTPUT
124
130
End Property
125
131
Public Property Let unifiedLFOutput(value As Boolean )
@@ -136,70 +142,97 @@ Attribute CloseStream.VB_Description = "Closes the current text file stream."
136
142
P_ISOPENSTREAM = False
137
143
End If
138
144
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
139
157
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
145
160
Dim EOLchr As EndLineChar
146
161
Dim missingEOLchar As Boolean
147
162
Dim EOStream As Boolean
148
- Dim tmpBuffer As String
149
163
150
164
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)
157
168
If missingEOLchar Then
158
- tmpBuffer = Buffer
169
+ DoubleBufferSize
170
+ SeekPointer TmpInitialPos
159
171
Get #FileHandled, , Buffer
160
- Buffer = tmpBuffer + Buffer
161
172
InitialPos = Seek (FileHandled)
162
173
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)
170
175
End If
171
176
Loop While missingEOLchar And Not EOStream
172
177
P_ATENDOFSTREAM = EOStream
173
178
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
183
200
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
198
203
Else
199
- CorrectedPos = InitialPos
204
+ NullCharPos = InStrB(Buffer, NullChar)
205
+ If NullCharPos Then
206
+ BufferMark = NullCharPos
207
+ End If
208
+ CorrectedPos = P_STREAMLENGTH + 1
200
209
End If
201
210
Seek #FileHandled, CorrectedPos
202
211
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
203
236
Private Sub NormalizeLineBreaks ()
204
237
If InStrB(1 , P_TEXT, vbCr, vbBinaryCompare) Then
205
238
P_TEXT = Replace(P_TEXT, vbCr, vbLf, 1 )
@@ -209,20 +242,22 @@ Private Sub NormalizeLineBreaks()
209
242
Loop
210
243
P_LINEBREAK = vbLf
211
244
End Sub
212
- Public Sub OpenStream (filePath As String )
245
+ Public Sub OpenStream (FilePath As String )
213
246
Attribute OpenStream.VB_Description = "Opens a stream over a text file."
214
247
FileHandled = FreeFile
215
- Open filePath For Binary As #FileHandled
248
+ Open FilePath For Binary As #FileHandled
216
249
P_ISOPENSTREAM = True
217
250
P_STREAMLENGTH = LOF(FileHandled)
218
251
StartVariables
219
252
End Sub
220
253
Public Sub ReadText ()
221
254
Attribute ReadText.VB_Description = "Reads a number of characters from the stream file and saves the result to the current instance."
222
255
If Not P_ATENDOFSTREAM And P_ISOPENSTREAM Then
256
+ If InitialPos = 0 Then InitialPos = 1
223
257
Select Case P_BUFFERLENGTH
224
258
Case Is < LCS
225
259
BufferDelta = 0
260
+ TmpInitialPos = InitialPos
226
261
Get #FileHandled, , Buffer
227
262
InitialPos = Seek (FileHandled)
228
263
BufferMark = LenB(Buffer)
@@ -278,20 +313,20 @@ End Sub
278
313
Public Sub WriteBlankLines (Lines As Long , Optional EndLineMark As EndLineChar = 0 )
279
314
Attribute WriteBlankLines.VB_Description = "Inserts a specified number of blank lines into the current opened text file."
280
315
If P_ISOPENSTREAM Then
281
- Dim Idx As Long
316
+ Dim idx As Long
282
317
Select Case EndLineMark
283
318
Case 0
284
- For Idx = 1 To Lines
319
+ For idx = 1 To Lines
285
320
Put #FileHandled, , vbCrLf
286
- Next Idx
321
+ Next idx
287
322
Case 1
288
- For Idx = 1 To Lines
323
+ For idx = 1 To Lines
289
324
Put #FileHandled, , vbCr
290
- Next Idx
325
+ Next idx
291
326
Case 2
292
- For Idx = 1 To Lines
327
+ For idx = 1 To Lines
293
328
Put #FileHandled, , vbLf
294
- Next Idx
329
+ Next idx
295
330
End Select
296
331
P_STREAMLENGTH = LOF(FileHandled)
297
332
End If
0 commit comments