@@ -9,14 +9,15 @@ Attribute VB_PredeclaredId = False
9
9
Attribute VB_Exposed = False
10
10
'#
11
11
'////////////////////////////////////////////////////////////////////////////////////////////
12
- ' Copyright © 2021 W. García
12
+ ' Copyright © 2021-2022 W. García
13
13
' GPL-3.0 license | https://www.gnu.org/licenses/gpl-3.0.html/
14
14
' https://ingwilfredogarcia.wordpress.com
15
15
'#
16
16
'////////////////////////////////////////////////////////////////////////////////////////////
17
17
' GENERAL INFO:
18
18
' ECPTextStream is an easy-to-use class module developed to enable I/O operations over "big"
19
- ' text files, at high speed, from VBA. The module hasn’t reference to any external API library.
19
+ ' text files, at high speed, from VBA. The module hasn’t reference to any external API
20
+ ' library and has the ability to read and write UTF-8 encoded files.
20
21
'////////////////////////////////////////////////////////////////////////////////////////////
21
22
'#
22
23
Option Explicit
@@ -25,7 +26,7 @@ Option Explicit
25
26
' CONSTANTS:
26
27
Private Const DualLFchar As String = vbLf & vbLf
27
28
Private Const InverseCRLF As String = vbLf & vbCr
28
- Private Const SizeFactor As Long = 524288
29
+ Private Const sizeFactor As Long = 524288
29
30
Private Const WhiteSpace As String = " "
30
31
'////////////////////////////////////////////////////////////////////////////////////////////
31
32
'#
@@ -38,10 +39,12 @@ Private P_ENDSTREAMONLINEBREAK As Boolean '--------If true, each stream ends on
38
39
Private P_ISOPENSTREAM As Boolean '----------------Indicates if the object is linked to a file
39
40
Private P_LINEBREAK As String '--------------------Holds the char used to end a Stream.
40
41
Private P_LINEBREAKMATCHINGBEHAVIOR As EndLineMatchingBehavior 'How to find the next line break.
41
- Private P_UNIFIEDLFOUTPUT As Boolean '-------------If true, the buffer string will be returned
42
- ' with the LF char as Line Break.
42
+ Private P_UNIFIEDLFOUTPUT As Boolean '-------------If true, the buffer string will be returned _
43
+ with the LF char as Line Break.
43
44
Private P_STREAMLENGTH As Long '-------------------File len.
44
45
Private P_TEXT As String '-------------------------Holds the current stream's text.
46
+ Private P_UTF8ENCODED As Boolean '-----------------Indicates when the file is supposed to be _
47
+ UTF8 encoded.
45
48
'////////////////////////////////////////////////////////////////////////////////////////////
46
49
'#
47
50
'////////////////////////////////////////////////////////////////////////////////////////////
@@ -93,15 +96,19 @@ Attribute bufferSize.VB_Description = "Gets or sets the buffer
93
96
End Property
94
97
Public Property Let bufferSize(value As Single )
95
98
P_BUFFERSIZE = value
96
- P_BUFFERLENGTH = CLng(P_BUFFERSIZE * SizeFactor )
99
+ P_BUFFERLENGTH = CLng(P_BUFFERSIZE * sizeFactor )
97
100
Buffer = SPACE$(P_BUFFERLENGTH)
98
101
End Property
99
102
Public Property Get bufferString() As String
100
103
Attribute bufferString.VB_Description = "Gets the text data stored in the buffer."
101
104
If P_UNIFIEDLFOUTPUT Then
102
105
NormalizeLineBreaks
103
106
End If
104
- bufferString = P_TEXT
107
+ If Not P_UTF8ENCODED Then
108
+ bufferString = P_TEXT
109
+ Else
110
+ bufferString = UTF8Decode(P_TEXT)
111
+ End If
105
112
End Property
106
113
Public Property Get endStreamOnLineBreak() As Boolean
107
114
Attribute endStreamOnLineBreak.VB_Description = "Allows to end buffer just after the first, from right to left, line break character."
@@ -113,9 +120,9 @@ End Property
113
120
Public Property Get isOpenStream() As Boolean
114
121
isOpenStream = P_ISOPENSTREAM
115
122
End Property
116
- Public Property Get lineBreak () As String
117
- 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."
118
- lineBreak = P_LINEBREAK
123
+ Public Property Get LineBreak () As String
124
+ 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."
125
+ LineBreak = P_LINEBREAK
119
126
End Property
120
127
Public Property Get linebreakMatchingBehavior() As EndLineMatchingBehavior
121
128
linebreakMatchingBehavior = P_LINEBREAKMATCHINGBEHAVIOR
@@ -136,12 +143,19 @@ Attribute streamLength.VB_Description = "Gets the current opened file
136
143
streamLength = P_STREAMLENGTH
137
144
End Property
138
145
Public Property Get unifiedLFOutput() As Boolean
139
- Attribute unifiedLFOutput.VB_Description = "Determines whether the buffer string is returned using only the LF character as a linefeed ."
146
+ Attribute unifiedLFOutput.VB_Description = "Determines whether the buffer string is returned using only the LF character as a line feed. Similarly, this property instruct to write files without the Unicode Byte Order Mark ."
140
147
unifiedLFOutput = P_UNIFIEDLFOUTPUT
141
148
End Property
142
149
Public Property Let unifiedLFOutput(value As Boolean )
143
150
P_UNIFIEDLFOUTPUT = value
144
151
End Property
152
+ Public Property Get utf8EncodedFile() As Boolean
153
+ Attribute utf8EncodedFile.VB_Description = "Indicates whether the buffer string is returned as a decoded string, assuming the file is UTF8 encoded."
154
+ utf8EncodedFile = P_UTF8ENCODED
155
+ End Property
156
+ Public Property Let utf8EncodedFile(value As Boolean )
157
+ P_UTF8ENCODED = value
158
+ End Property
145
159
'////////////////////////////////////////////////////////////////////////////////////////////
146
160
'#
147
161
'////////////////////////////////////////////////////////////////////////////////////////////
@@ -156,7 +170,7 @@ End Sub
156
170
Private Sub DoubleBufferSize ()
157
171
Dim LCSt As Long
158
172
P_BUFFERSIZE = 2 * P_BUFFERSIZE
159
- P_BUFFERLENGTH = CLng(P_BUFFERSIZE * SizeFactor )
173
+ P_BUFFERLENGTH = CLng(P_BUFFERSIZE * sizeFactor )
160
174
LCSt = P_STREAMLENGTH - P_BUFFERLENGTH
161
175
Select Case LCSt
162
176
Case Is > 0
@@ -318,44 +332,82 @@ Attribute SeekPointer.VB_Description = "Moves the pointer, over the target file,
318
332
End Sub
319
333
Private Sub StartVariables ()
320
334
CorrectedPos = 0
321
- P_BUFFERLENGTH = CLng(P_BUFFERSIZE * SizeFactor )
335
+ P_BUFFERLENGTH = CLng(P_BUFFERSIZE * sizeFactor )
322
336
Buffer = SPACE$(P_BUFFERLENGTH)
323
337
LCS = P_STREAMLENGTH
324
338
P_ATENDOFSTREAM = False
325
339
End Sub
340
+ Public Function UTF8Decode (ByVal sStr As String ) As String
341
+ Dim l As Long , sUTF8 As CSVArrayList , iChar As Long , iChar2 As Long
342
+
343
+ On Error GoTo UTF8_Decode_error
344
+ Set sUTF8 = New CSVArrayList
345
+ For l = 1 To LenB(sStr) Step 2
346
+ iChar = Asc(MidB$(sStr, l, 2 ))
347
+ If iChar > 127 Then
348
+ If Not iChar And 32 Then ' 2 chars
349
+ iChar2 = Asc(MidB$(sStr, l + 2 , 2 ))
350
+ sUTF8.Add ChrW$(((31 And iChar) * 64 + (63 And iChar2)))
351
+ l = l + 2
352
+ Else
353
+ Dim iChar3 As Integer
354
+ iChar2 = Asc(MidB$(sStr, l + 2 , 2 ))
355
+ iChar3 = Asc(MidB$(sStr, l + 4 , 2 ))
356
+ sUTF8.Add ChrW$(((iChar And 15 ) * 16 * 256 ) + ((iChar2 And 63 ) * 64 ) + (iChar3 And 63 ))
357
+ l = l + 4
358
+ End If
359
+ Else
360
+ sUTF8.Add ChrW$(iChar)
361
+ End If
362
+ Next l
363
+ UTF8Decode = Join$(sUTF8.items, vbNullString)
364
+ Set sUTF8 = Nothing
365
+ Exit Function
366
+ UTF8_Decode_error:
367
+ Set sUTF8 = Nothing
368
+ UTF8Decode = vbNullString
369
+ End Function
326
370
Public Sub WriteBlankLines (Lines As Long , Optional EndLineMark As EndLineChar = 0 )
327
371
Attribute WriteBlankLines.VB_Description = "Inserts a specified number of blank lines into the current opened text file."
328
372
If P_ISOPENSTREAM Then
329
- Dim idx As Long
373
+ Dim Idx As Long
330
374
Select Case EndLineMark
331
375
Case 0
332
- For idx = 1 To Lines
333
- Put #FileHandled, , vbCrLf
334
- Next idx
376
+ For Idx = 1 To Lines
377
+ WriteText vbCrLf
378
+ Next Idx
335
379
Case 1
336
- For idx = 1 To Lines
337
- Put #FileHandled, , vbCr
338
- Next idx
380
+ For Idx = 1 To Lines
381
+ WriteText vbCr
382
+ Next Idx
339
383
Case 2
340
- For idx = 1 To Lines
341
- Put #FileHandled, , vbLf
342
- Next idx
384
+ For Idx = 1 To Lines
385
+ WriteText vbLf
386
+ Next Idx
343
387
End Select
344
388
P_STREAMLENGTH = LOF(FileHandled)
345
389
End If
346
390
End Sub
347
391
Public Sub WriteText (ByRef TextData As String )
348
392
Attribute WriteText.VB_Description = "Writes the given string to the current opened text file."
349
393
If P_ISOPENSTREAM Then
350
- Put #FileHandled, , TextData
394
+ If Not P_UTF8ENCODED Then
395
+ Put #FileHandled, , TextData
396
+ Else
397
+ Dim BuffferBytes() As Byte
398
+ BuffferBytes = TextData
399
+ Put #FileHandled, , BuffferBytes
400
+ Erase BuffferBytes
401
+ End If
351
402
P_STREAMLENGTH = LOF(FileHandled)
352
403
End If
353
404
End Sub
354
405
'////////////////////////////////////////////////////////////////////////////////////////////
355
406
Private Sub Class_Initialize ()
356
407
P_BUFFERSIZE = 0.5
357
- P_BUFFERLENGTH = CLng(P_BUFFERSIZE * SizeFactor )
408
+ P_BUFFERLENGTH = CLng(P_BUFFERSIZE * sizeFactor )
358
409
P_ENDSTREAMONLINEBREAK = False
410
+ P_UTF8ENCODED = False
359
411
P_LINEBREAKMATCHINGBEHAVIOR = EndLineMatchingBehavior.Bidirectional
360
412
P_UNIFIEDLFOUTPUT = False
361
413
Buffer = SPACE$(P_BUFFERLENGTH)
0 commit comments