VBA CSV格式的解析类 【c语言CSV Parser转换】

  1 Option Explicit
  2 ‘----------------读Csv文件 类---------------------
  3 
  4 Private Declare Function WideCharToMultiByte Lib "kernel32" _
  5     (ByVal CodePage As Long, _
  6      ByVal dwFlags As Long, _
  7      ByVal lpWideCharStr As Long, _
  8      ByVal cchWideChar As Long, _
  9      ByRef lpMultiByteStr As Any, _
 10      ByVal cchMultiByte As Long, _
 11      ByVal lpDefaultChar As String, _
 12      ByVal lpUsedDefaultChar As Long) As Long
 13 
 14 Private Declare Function MultiByteToWideChar Lib "kernel32" _
 15     (ByVal CodePage As Long, _
 16      ByVal dwFlags As Long, _
 17      ByRef lpMultiByteStr As Any, _
 18      ByVal cchMultiByte As Long, _
 19      ByVal lpWideCharStr As Long, _
 20      ByVal cchWideChar As Long) As Long
 21      
 22 Private Type BuffType ‘一个缓冲区
 23     StartPosAbso As Long ‘该缓冲区在文件中的绝对位置
 24     BufLen As Long  ‘缓冲区总长
 25     PtrInBuf As Long ‘缓冲区内部指针
 26     ptrNextStrStartInBuf As Long ‘下一行内容开始位置(从此处算到下一个cr/lf为下一行)
 27     IgnoreFirstLf As Boolean ‘是否忽略本缓冲区的第一个 vblf
 28     bufBytes() As Byte ‘缓冲区内容（字节数组）
 29 End Type
 30 
 31 
 32 Dim State As StateType
 33 Private Enum StateType
 34     NewFieldStart
 35     NonQuotesField
 36     QuotesField
 37     FieldSeparator
 38     QuoteInQuotesField
 39     RowSeparator
 40     ErrorS
 41 End Enum
 42 
 43 Dim af_Buff As BuffType ‘一个缓冲区
 44 Dim af_lngFileLength As Long
 45 
 46 Dim lFileName As String
 47 Dim lFileNum As Integer
 48 Dim lStatus As Integer ‘-1=已关闭;1=已打开;2=已经开始读取;0=未设
 49 Dim lIsEndRead As Boolean ‘=true表示或者读完文件或者出错，即不能再继续读了，主程序应退出读取
 50 Dim lErrOccured As Boolean ‘是否上次 GetNextLine 发生了一个错误
 51 Dim lAutoOpen As Boolean ‘是否设置 FileName 属性时自动打开文件，默认为true(类初始化时设为true)
 52 Dim lAutoClose As Boolean ‘是否 读取行读完文件或出错时 自动关闭文件，默认为true(类初始化时设为true)
 53 
 54 
 55 
 56 
 57 Dim lEncode As Long ‘编码设置
 58 Dim EncodeErr As Boolean ‘编码转换时出错Flag
 59 Public Enum EncodeEnum
 60     Default = 0
 61     ShifJis = 932
 62     JIS = 50220
 63     Utf8 = 65001
 64     GB2312 = 936
 65 End Enum
 66 
 67 
 68 Dim ch As Long
 69 ‘以上仅为GetNextLine函数用，为了不每次调用GetNextLine时候都重新定义，故将之做为全局的了，其实应是局部的
 70 ‘_______________________________________
 71 Dim lineArr As New Collection
 72 Dim strArr() As Byte
 73 Dim strArrlBuff As Long
 74 Private Const mcInitBuffSize As Long = 100 ‘初始分配空间大小，10K
 75 
 76 Public Function GetNextLine(ByRef col As Collection) As Integer
 77     ‘读取文件的下一行文本，支持 vbCrLf、vbLf、vbCr 的多种分行符
 78     ‘返回1表示正常读取了
 79     ‘返回-1也表示正常，但读完了文件
 80     ‘返回0表示出错或非法
 81     ‘1. 一般出错返回0，并设置 lErrOccured=True
 82     ‘2. 如果上次读完了文件，则允许再额外调用一次 GetNextLine (返回 0 并 _
 83       不提示出错，lErrOccured 仍为 false，此算非法)；如果再调用就出错了 _
 84       (函数仍返回0，但 lErrOccured 为 true 此算出错)
 85 
 86 
 87     ‘设置反映错误的标志变量
 88     lErrOccured = False ‘表示尚未发生错误；如后续程序中发生了错误再改为 True
 89     ‘判断和设置状态
 90     If lStatus = 0 Then
 91         ‘lStatus = 0：当前状态非法，尚未打开文件，无法读取
 92         GoTo errExit
 93     ElseIf lStatus < 0 Then
 94         GoTo errExit ‘不允许额外调用了，出错
 95     End If
 96     
 97     ‘正常读取的情况：此时 lStatus 要么为1要么为2，即要么文件已经打开， _
 98       ‘要么已经进入读取状态了，总之读取下一行是没有问题的
 99     lStatus = 2 ‘设置为2表示已经进入读取状态
100     
101     
102     ‘//////////////// 读取文件，以找到“一行”的内容 ////////////////
103     On Error GoTo errExit  ‘有任何错误发生时都转到errExit标签处执行
104     
105     With af_Buff
106         ‘缓冲区逐渐沿文件前进，直到缓冲区起始位置超过文件总长读完文件
107         Do Until .StartPosAbso > af_lngFileLength
108         
109             ‘============ （1）根据需要读取文件的下一个缓冲区内容 ============
110             ‘若 .PtrInBuf=-1 表示要读取下一个缓冲区，否则不读取下一个，仍使用 _
111               当前缓冲区和 .PtrInBuf 指针
112             If .PtrInBuf < 0 Then
113                 ‘----从 .StartPosAbso 开始读取一些字节存入缓冲区 .bufBytes()
114                 .BufLen = FileGetBytesLocal(.StartPosAbso, .bufBytes())
115                 If .BufLen <= 0 Then GoTo errExit ‘读取出错
116                 
117                 ‘----初始化缓冲区指针
118                 .PtrInBuf = 1
119                 ‘看是否需要忽略第一个 vbLf
120                 If .IgnoreFirstLf Then
121                     If .bufBytes(.PtrInBuf) = 10 Then ‘第1个字节确是 vbLf
122                         ‘忽略第一个 vbLf
123                         .PtrInBuf = .PtrInBuf + 1
124                     End If ‘If .bufBytes(.PtrInBuf) = 10 Then
125                     
126                     .IgnoreFirstLf = False ‘恢复标志，不忽略第一个 vbLf
127                 End If ‘If .IgnoreFirstLf Then
128                 
129                 ‘初始化下一行起始位置 ptrNextStrStartInBuf （下一行内容包含该字节）
130                 .ptrNextStrStartInBuf = .PtrInBuf
131             End If ‘If .PtrInBuf < 0 Then
132             
133             ‘============ （2）逐个扫描缓冲区中的字节，查找分行符 ============
134             ‘扫描缓冲区中的字节，直到找到 vbCr或vbLf 或扫描完缓冲区
135             For .PtrInBuf = .PtrInBuf To .BufLen
136                 ch = .bufBytes(.PtrInBuf)
137                 Select Case State ‘34代表双引号 44代表逗号
138                     Case NewFieldStart
139                         If ch = 34 Then
140                             State = QuotesField
141                         ElseIf ch = 44 Then
142                             lineArr.Add ""
143                             State = FieldSeparator
144                         ElseIf ch = 13 Or ch = 10 Then
145                             State = NewFieldStart
146                             Exit For
147                         Else
148 
149                             strArrlBuff = strArrlBuff + 1
150                             If strArrlBuff Mod mcInitBuffSize = 0 Then
151                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
152                             End If
153                             ‘ReDim Preserve strArr(1 To strArrlBuff)
154                             strArr(strArrlBuff) = ch
155                             ‘strArr.Add ch
156                             State = NonQuotesField
157                         End If
158                     Case NonQuotesField
159                         If ch = 44 Then
160                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr
161                             Erase strArr
162                             ReDim strArr(1 To mcInitBuffSize)
163                             strArrlBuff = 0
164                             ‘Set strArr = New Collection
165                             State = FieldSeparator
166                         ElseIf ch = 13 Then
167                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr
168                             State = RowSeparator
169                         Else
170                             strArrlBuff = strArrlBuff + 1
171                             If strArrlBuff Mod mcInitBuffSize = 0 Then
172                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
173                             End If
174                             ‘ReDim Preserve strArr(1 To strArrlBuff)
175                             strArr(strArrlBuff) = ch
176                             ‘strArr.Add ch
177                         End If
178                     Case QuotesField
179                         If ch = 34 Then
180                             State = QuoteInQuotesField
181                         Else
182                             strArrlBuff = strArrlBuff + 1
183                             If strArrlBuff Mod mcInitBuffSize = 0 Then
184                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
185                             End If
186                             ‘ReDim Preserve strArr(1 To strArrlBuff)
187                             strArr(strArrlBuff) = ch
188                             ‘strArr.Add ch
189                         End If
190                     Case FieldSeparator
191                         If ch = 44 Then
192                             lineArr.Add ""
193                         ElseIf ch = 34 Then
194                             Erase strArr
195                             ReDim strArr(1 To mcInitBuffSize)
196                             strArrlBuff = 0
197                             ‘Set strArr = New Collection
198                             State = QuotesField
199                         ElseIf ch = 13 Then
200                             lineArr.Add ""
201                             State = RowSeparator
202                         Else
203                             strArrlBuff = strArrlBuff + 1
204                             If strArrlBuff Mod mcInitBuffSize = 0 Then
205                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
206                             End If
207                             ‘ReDim Preserve strArr(1 To strArrlBuff)
208                             strArr(strArrlBuff) = ch
209                             ‘strArr.Add ch
210                             State = NonQuotesField
211                         End If
212                     Case QuoteInQuotesField
213                         If ch = 44 Then
214                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr
215                             Erase strArr
216                             ReDim strArr(1 To mcInitBuffSize)
217                             strArrlBuff = 0
218                             ‘Set strArr = New Collection
219                             State = FieldSeparator
220                         ElseIf ch = 13 Then
221                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr
222                             State = RowSeparator
223                         ElseIf ch = 34 Then
224                             strArrlBuff = strArrlBuff + 1
225                             If strArrlBuff Mod mcInitBuffSize = 0 Then
226                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
227                             End If
228                             ‘ReDim Preserve strArr(1 To strArrlBuff)
229                             strArr(strArrlBuff) = ch
230                             ‘strArr.Add ch
231                             State = QuotesField
232                         Else
233                             State = ErrorS ‘"语法错误： 转义字符 \" 不能完成转义 或 引号字段结尾引号没有紧贴字段分隔符";
234                         End If
235                     Case RowSeparator
236                         If ch = 10 Then
237                             Erase strArr
238                             ReDim strArr(1 To mcInitBuffSize)
239                             strArrlBuff = 0
240                             ‘Set strArr = New Collection
241                             State = NewFieldStart
242                             Exit For
243                         Else
244                             State = ErrorS ‘"语法错误： 行分隔用了回车 \\r。但未使用回车换行 \\r\\n ";
245                         End If
246                     Case ErrorS
247                         GoTo errExit
248                                             
249                 End Select
250 
251 ‘                If .bufBytes(.PtrInBuf) = 13 Or _
252 ‘                 .bufBytes(.PtrInBuf) = 10 Then Exit For
253             Next .PtrInBuf
254             
255             ‘退出 For 后，判断是否找到了分行符 vbCr或vbLf
256             If .PtrInBuf <= .BufLen Then  ‘是否找到了 vbCr或vbLf
257                 If .PtrInBuf + 1 > .BufLen And _
258                   .StartPosAbso + .BufLen > af_lngFileLength Then
259                     ‘已经读完文件
260                     lIsEndRead = True
261                     If lAutoClose Then CloseFile
262                 Else
263                     ‘还未读完文件，再判断是否文件只剩一个字节；若只剩一个字节并且 _
264                       ‘剩下的正好是 vbLf，并且下次要忽略掉 vbLf，则仍是已经读完文件
265                     If .StartPosAbso + .BufLen = af_lngFileLength And .IgnoreFirstLf Then
266                         ‘读取文件中的最后一个字节，只测试一下
267                         Dim tByt() As Byte, tRet As Integer
268                         tRet = FileGetBytesLocal(.StartPosAbso + .BufLen, tByt())
269                         If tRet <= 0 Then GoTo errExit ‘出错处理
270                         If tByt(1) = 10 Then
271                             ‘已经读完文件
272                             lIsEndRead = True
273                             If lAutoClose Then CloseFile
274                         End If
275                     End If
276                 End If
277                 .PtrInBuf = .PtrInBuf + 1
278             
279                 If lIsEndRead Then
280                     ‘已经读完文件，一定 Exit Function
281                     
282                     Set col = lineArr
283                     Set lineArr = New Collection
284                     strArrlBuff = 0
285                     GetNextLine = 0
286                     
287                     Exit Function ‘已经读完文件，一定 Exit Function
288                 Else ‘If lIsEndRead Then
289                     ‘没有读完文件(忽略空行不退出，否则退出)
290                         If GetNextLine = 0 Then
291                         ‘不需要忽略空行或最后不是空行，退出
292                         Else
293                             Set col = lineArr
294                             Set lineArr = New Collection
295                             strArrlBuff = 0
296                             GetNextLine = 1
297                             Exit Function
298                         End If
299                 End If ‘If lIsEndRead Then
300                 
301             Else ‘If .PtrInBuf <= .BufLen Then ‘是否找到了 vbCr或vbLf
302                  
303                  .PtrInBuf = -1
304                 ‘==== 准备继续读下一个缓冲区 ====
305                 .StartPosAbso = .StartPosAbso + .BufLen
306             End If ‘If .PtrInBuf <= .BufLen Then ‘是否找到了 vbCr或vbLf
307         Loop
308     End With
309     
310     
311     ‘//////////// 全部读完文件，看还有无剩余的 ////////////
312    
313         
314         Select Case State
315             Case NonQuotesField
316                  lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr
317                  Erase strArr
318                  ReDim strArr(1 To mcInitBuffSize)
319                  strArrlBuff = 0
320                  ‘lineArr.Add strArr
321                  ‘Set strArr = New Collection
322             Case QuotesField
323                  GoTo errExit ‘"语法错误： 引号字段未闭合";
324             Case FieldSeparator
325                 lineArr.Add ""
326             Case QuoteInQuotesField
327                 lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr
328                 
329         End Select
330         
331 
332         Set col = lineArr
333         Set lineArr = New Collection
334         strArrlBuff = 0
335 
336         GetNextLine = 0
337 
338         
339         If lAutoClose Then CloseFile
340         lIsEndRead = True
341         ‘此时读完文件，必须返回
342         Exit Function
343 
344     
345 
346 errExit:
347     lErrOccured = True
348     GetNextLine = 0
349     ‘为一般错误，不设置 lIsEndRead = True
350     If lAutoClose Then CloseFile
351 End Function
352 
353 Private Function EncodeStr(ByRef bytIn() As Byte, hasError As Boolean, Optional byteSize As Long = -1) As String
354 
355     Select Case Encode
356         Case Default
357             Dim tempStr As String
358             tempStr = bytIn
359             EncodeStr = StrConv(tempStr, vbUnicode)
360 
361         Case ShifJis
362             EncodeStr = WCMB_Decode(ShifJis, bytIn, hasError, byteSize)
363         Case JIS
364              EncodeStr = WCMB_Decode(JIS, bytIn, hasError, byteSize)
365         Case Utf8
366             EncodeStr = WCMB_Decode(Utf8, bytIn, hasError, byteSize)
367         Case GB2312
368              EncodeStr = WCMB_Decode(GB2312, bytIn, hasError, byteSize)
369     End Select
370 
371 End Function
372 
373 
374 ‘ 関数名    : WCMB_Decode
375 ‘ 返り値    : UNICODE文字列
376 ‘ 引き数    : cp    : 入力文字データのコードページ番号
377 ‘           : bytIn : 入力文字データ
378 ‘ 機能説明  : 入力文字データをUNICODEに変換する
379 ‘ 備考      : MultiByteToWideCharによる文字コード変換
380 Private Function WCMB_Decode(ByVal cp As Long, ByRef bytIn() As Byte, ByRef hasError As Boolean, Optional byteSize As Long = -1) As String
381     On Error GoTo ErrHandler
382 
383     Dim lngInSize As Long
384     Dim strBuf As String
385     Dim lngBufLen As Long
386     Dim lngRtn As Long
387     If byteSize > 0 Then
388         lngInSize = byteSize
389     Else
390         If bytIn(UBound(bytIn)) = 13 Then
391             lngInSize = UBound(bytIn) - 1
392         Else
393             lngInSize = UBound(bytIn)
394         End If
395     End If
396     lngBufLen = (lngInSize + 1) * 5
397     strBuf = String$(lngBufLen, vbNullChar)
398     lngRtn = MultiByteToWideChar _
399         (cp, 0, bytIn(1), lngInSize, StrPtr(strBuf), lngBufLen)
400     If lngRtn Then
401         WCMB_Decode = Left$(strBuf, lngRtn)
402     End If
403     hasError = False
404     Exit Function
405 ErrHandler:
406     WCMB_Decode = ""
407     hasError = True
408 End Function
409 
410 Public Sub Init()
411 
412     ReDim strArr(1 To mcInitBuffSize) ‘CSV 各个单元 缓冲区
413     strArrlBuff = 0
414                  
415     Erase af_Buff.bufBytes ‘缓冲区
416     
417     
418 
419     af_lngFileLength = 0
420     af_Buff.StartPosAbso = 1 ‘当前缓冲区的起始处所在的文件位置
421     af_Buff.ptrNextStrStartInBuf = 1
422     
423     ‘此作为标志，=-1表示下次运行 GetNextLine 要重新读取新的缓冲区 _
424       ‘否则不重新读取，仍使用当前缓冲区和 .PtrInBuf 指针
425     af_Buff.PtrInBuf = -1
426     
427     lErrOccured = False
428 
429     
430     af_Buff.IgnoreFirstLf = False ‘初始化标志：当前缓冲区不需要忽略第一个字节（若是vblf）
431     
432     lIsEndRead = False
433 End Sub
434 
435 Public Function GetPercent(Optional DotNum As Integer = 2) As Single
436     ‘DotNum保留几位小数，<0或>7为不保留小数
437     Dim sngPerc As Single
438     
439     If af_lngFileLength > 0 Then
440         If af_Buff.PtrInBuf < 0 Then
441             sngPerc = (af_Buff.StartPosAbso - 1) / af_lngFileLength
442         Else
443             sngPerc = (af_Buff.StartPosAbso + af_Buff.PtrInBuf - 2) / af_lngFileLength
444         End If
445     End If
446     
447     If DotNum >= 0 Or DotNum <= 7 Then
448         Dim Temp As Long
449         Temp = 10 ^ DotNum
450         sngPerc = Int(Temp * sngPerc + 0.5) / Temp
451     End If
452     
453     GetPercent = sngPerc
454 End Function
455 
456 Public Sub CloseFile()
457     If lFileNum > 0 Then Close lFileNum: lFileNum = 0
458     lStatus = -1 ‘表示文件已关闭
459     ‘不Init，防止读取行后自动关闭文件时状态变量被初始化；在OpenFile时会Init
460 End Sub
461 
462 Public Function OpenFile() As Boolean
463     If lFileNum > 0 Then CloseFile ‘如果已打开了文件，则先关闭它
464     lFileNum = FreeFile ‘获得一个可用的文件号（同时属性 FileNum 的值也自动改变）
465     On Error GoTo errH ‘如果一下程序发生任何错误，就转到 errH 标签处执行
466     If Dir(lFileName, 31) = "" Then GoTo errH ‘如果文件不存在，就转到 errH 标签处执行
467     Open lFileName For Binary Access Read As #lFileNum ‘以二进制方式打开文件
468     lStatus = 1 ‘表示文件已打开
469     Init ‘初始化操作
470     af_lngFileLength = LOF(lFileNum) ‘设置文件总大小
471     OpenFile = True
472     Exit Function
473 errH:
474     If lFileNum > 0 Then CloseFile
475     OpenFile = False
476 End Function
477 
478 
479 
480 Private Function FileGetBytesLocal(ByVal ReadPos As Long, _
481                                          ArrBytes() As Byte, _
482                           Optional ByVal EndingBorder As Long = 0, _
483                           Optional ByVal ReadMax As Long = 16384) As Long
484                           ‘Optional ByVal ReadMax As Long = 16384, _
485     ‘从文件号 lFileNum 中的 ReadPos 位置开始读取一批字节
486     ‘从参数ArrBytes()返回读取的字节内容，会重新定义ArrBytes()数组
487     ‘所读取的字节数不确定，如果文件中有足够的内容，就读取ReadMax个字节， _
488       ‘否则就读到文件尾（当EndingBorder参数<=0时）或读到EndingBorder _
489       ‘为止（当EndingBorder参数>0时）
490     ‘ShowResume 指定如果读取出错，是否弹出对话框提示
491       ‘若ShowResume=1，提示框中有"重试"和"取消"两个按钮；
492       ‘若ShowResume=2，出错时提示框中有"终止"、"重试"和"忽略"三个按钮；
493       ‘若ShowResume=0，出错时不弹出提示框，不弹出提示框就不能在发生错误时重试
494     ‘返回读取的字节数，若失败返回<=0，若用户“忽略”则返回=0；_
495       ‘若用户终止或取消或无提示框，则返回<0
496     
497     Dim lngUBound As Long
498     
499     If EndingBorder <= 0 Then EndingBorder = LOF(lFileNum)
500     If EndingBorder < ReadPos Then
501         FileGetBytesLocal = -1
502         Exit Function
503     End If
504     
505     On Error GoTo errH
506     If EndingBorder - ReadPos + 1 >= ReadMax Then lngUBound = ReadMax Else _
507       lngUBound = EndingBorder - ReadPos + 1
508     
509     ReDim ArrBytes(1 To lngUBound) As Byte
510     
511     Get #FileNum, ReadPos, ArrBytes
512 
513     FileGetBytesLocal = lngUBound
514     Exit Function
515 errH:
516      FileGetBytesLocal = -1
517 End Function
518 
519 
520 
521 Private Sub Class_Initialize()
522     lAutoOpen = True ‘设置 FileName 属性时自动打开文件
523     lAutoClose = True ‘读取行读完文件或出错时 自动关闭文件
524 End Sub
525 
526 Private Sub Class_Terminate()
527     CloseFile
528     Erase af_Buff.bufBytes
529 
530 End Sub
531 
532 
533 Public Property Get FileName() As String
534     FileName = lFileName
535 End Property
536 
537 Public Property Let FileName(ByVal vNewValue As String)
538     If lFileNum > 0 Then CloseFile
539     lFileName = vNewValue
540     If lAutoOpen Then OpenFile
541 End Property
542 
543 Public Property Get FileNum() As Integer
544     FileNum = lFileNum
545 End Property
546 
547 Public Property Get Status() As Integer
548     Status = lStatus
549 End Property
550 
551 Public Property Get IsEndRead() As Boolean
552     IsEndRead = lIsEndRead
553 End Property
554 
555 Public Property Get AutoOpen() As Boolean
556     AutoOpen = lAutoOpen
557 End Property
558 
559 Public Property Let AutoOpen(ByVal vNewValue As Boolean)
560     lAutoOpen = vNewValue
561 End Property
562 
563 Public Property Get AutoClose() As Boolean
564     AutoClose = lAutoClose
565 End Property
566 
567 Public Property Let AutoClose(ByVal vNewValue As Boolean)
568     lAutoClose = vNewValue
569 End Property
570 
571 
572 Public Property Get ErrOccured() As Boolean
573     ErrOccured = lErrOccured
574 End Property
575 
576 Public Property Let ErrOccured(ByVal vNewValue As Boolean)
577     lErrOccured = vNewValue
578 End Property
579 
580 Public Property Get Encode() As EncodeEnum
581     Encode = lEncode
582 End Property
583 
584 Public Property Let Encode(ByVal vNewValue As EncodeEnum)
585     lEncode = vNewValue
586 End Property
587 
588 Public Property Get IsEncodeErr() As Boolean
589     IsEncodeErr = EncodeErr
590 End Property

  1 Option Explicit
  2 ‘----------------读Csv文件 类---------------------
  3 
  4 Private Declare Function WideCharToMultiByte Lib "kernel32" _
  5     (ByVal CodePage As Long, _
  6      ByVal dwFlags As Long, _
  7      ByVal lpWideCharStr As Long, _
  8      ByVal cchWideChar As Long, _
  9      ByRef lpMultiByteStr As Any, _
 10      ByVal cchMultiByte As Long, _
 11      ByVal lpDefaultChar As String, _
 12      ByVal lpUsedDefaultChar As Long) As Long
 13 
 14 Private Declare Function MultiByteToWideChar Lib "kernel32" _
 15     (ByVal CodePage As Long, _
 16      ByVal dwFlags As Long, _
 17      ByRef lpMultiByteStr As Any, _
 18      ByVal cchMultiByte As Long, _
 19      ByVal lpWideCharStr As Long, _
 20      ByVal cchWideChar As Long) As Long
 21      
 22 Private Type BuffType ‘一个缓冲区
 23     StartPosAbso As Long ‘该缓冲区在文件中的绝对位置
 24     BufLen As Long  ‘缓冲区总长
 25     PtrInBuf As Long ‘缓冲区内部指针
 26     ptrNextStrStartInBuf As Long ‘下一行内容开始位置(从此处算到下一个cr/lf为下一行)
 27     IgnoreFirstLf As Boolean ‘是否忽略本缓冲区的第一个 vblf
 28     bufBytes() As Byte ‘缓冲区内容（字节数组）
 29 End Type
 30 
 31 Private Type LastBuffType ‘缓冲区剩余的字节
 32     LeftBytes() As Byte
 33     LeftBLen As Long
 34 End Type
 35 
 36 Dim State As StateType
 37 Private Enum StateType
 38     NewFieldStart
 39     NonQuotesField
 40     QuotesField
 41     FieldSeparator
 42     QuoteInQuotesField
 43     RowSeparator
 44     ErrorS
 45 End Enum
 46 
 47 Dim af_Buff As BuffType ‘一个缓冲区
 48 Dim af_LastBuff As LastBuffType ‘缓冲区剩余的字节
 49 Dim af_OneEndRead As Boolean ‘是否在关闭文件后还允许再调用一次 GetNextLine
 50 Dim af_lngFileLength As Long
 51 
 52 Dim lFileName As String
 53 Dim lFileNum As Integer
 54 Dim lStatus As Integer ‘-1=已关闭;1=已打开;2=已经开始读取;0=未设
 55 Dim lIsEndRead As Boolean ‘=true表示或者读完文件或者出错，即不能再继续读了，主程序应退出读取
 56 Dim lErrOccured As Boolean ‘是否上次 GetNextLine 发生了一个错误
 57 Dim lTrimSpaces As Boolean
 58 Dim lAutoOpen As Boolean ‘是否设置 FileName 属性时自动打开文件，默认为true(类初始化时设为true)
 59 Dim lAutoClose As Boolean ‘是否 读取行读完文件或出错时 自动关闭文件，默认为true(类初始化时设为true)
 60 Dim lIgnoreEmpty As Boolean ‘是否自动忽略空行（注意：如果是最后一行仍可能返回空行）
 61 
 62 Dim lEndLineSign As Integer    ‘行的结束标志:0=未设。13,10 or 2573(vbcrlf) ；-1:unknown(此时再次调用GetNextLine后看EndLineSignLast获得)；-2:未知，读到文件末尾，文件末尾无换行符
 63 Dim lEndLineSignLast As Integer  ‘上一行的结束标志 0=未设
 64 
 65 Dim lEncode As Long ‘编码设置
 66 Dim EncodeErr As Boolean ‘编码转换时出错Flag
 67 Public Enum EncodeEnum
 68     Default = 0
 69     ShifJis = 932
 70     JIS = 50220
 71     Utf8 = 65001
 72     GB2312 = 936
 73 End Enum
 74 
 75 
 76 Dim af_strBuf As String
 77 Dim af_bytsBuf() As Byte
 78 Dim j As Long
 79 Dim ch As Long
 80 ‘以上仅为GetNextLine函数用，为了不每次调用GetNextLine时候都重新定义，故将之做为全局的了，其实应是局部的
 81 ‘_______________________________________
 82 Dim lineArr As New Collection
 83 Dim strArr() As Byte
 84 Dim strArrlBuff As Long
 85 Private Const mcInitBuffSize As Long = 100 ‘初始分配空间大小，10K
 86 
 87 Public Function GetNextLine(ByRef RetString As String, ByRef col As Collection) As Integer
 88     ‘读取文件的下一行文本，支持 vbCrLf、vbLf、vbCr 的多种分行符
 89     ‘返回1表示正常读取了
 90     ‘返回-1也表示正常，但读完了文件
 91     ‘返回0表示出错或非法
 92     ‘1. 一般出错返回0，并设置 lErrOccured=True
 93     ‘2. 如果上次读完了文件，则允许再额外调用一次 GetNextLine (返回 0 并 _
 94       不提示出错，lErrOccured 仍为 false，此算非法)；如果再调用就出错了 _
 95       (函数仍返回0，但 lErrOccured 为 true 此算出错)
 96     ‘3. lIgnoreEmpty=True 时自动忽略空行，如果从当前一直读到文件结束 _
 97       都是空行，则都忽略，并返回0（此时 lErrOccured=false，此算非法）
 98     ‘只有要设置 lErrOccured=true 才会在 lShowMsgIfErrRead=true 时给出出错提示
 99     
100     
101     ‘设置 反映分行符的 lEndLineSign 和 lEndLineSignLast 标志变量
102     lEndLineSignLast = lEndLineSign ‘将上一行的分行符更新为当前行的分行符
103     lEndLineSign = 0 ‘将当前行的分行符先设为0，在后面程序读完本行后再具体设置
104     ‘设置反映错误的标志变量
105     lErrOccured = False ‘表示尚未发生错误；如后续程序中发生了错误再改为 True
106     ‘判断和设置状态
107     If lStatus = 0 Then
108         ‘lStatus = 0：当前状态非法，尚未打开文件，无法读取
109         GoTo errExit
110     ElseIf lStatus < 0 Then
111         ‘lStatus<0：表示此时文件尚未被打开，或者被强制关闭，或者已经读完文件 _
112           ‘被自动关闭，总之是不能再继续读取文件了
113         ‘若文件已读取完毕，允许再额外地调用一次GetNextLine方法
114         If af_OneEndRead Then ‘允许额外调用一次
115             af_OneEndRead = False ‘设置标志为 False，不允许再额外调用
116             GetNextLine = 0 ‘不出错，但返回0
117             Exit Function ‘此时 lErrOccured 仍为 False
118         End If
119         GoTo errExit ‘不允许额外调用了，出错
120     End If
121     
122     ‘正常读取的情况：此时 lStatus 要么为1要么为2，即要么文件已经打开， _
123       ‘要么已经进入读取状态了，总之读取下一行是没有问题的
124     lStatus = 2 ‘设置为2表示已经进入读取状态
125     
126     
127     ‘//////////////// 读取文件，以找到“一行”的内容 ////////////////
128     On Error GoTo errExit  ‘有任何错误发生时都转到errExit标签处执行
129     
130     With af_Buff
131         ‘缓冲区逐渐沿文件前进，直到缓冲区起始位置超过文件总长读完文件
132         Do Until .StartPosAbso > af_lngFileLength
133         
134             ‘============ （1）根据需要读取文件的下一个缓冲区内容 ============
135             ‘若 .PtrInBuf=-1 表示要读取下一个缓冲区，否则不读取下一个，仍使用 _
136               当前缓冲区和 .PtrInBuf 指针
137             If .PtrInBuf < 0 Then
138                 ‘----从 .StartPosAbso 开始读取一些字节存入缓冲区 .bufBytes()
139                 .BufLen = FileGetBytesLocal(.StartPosAbso, .bufBytes())
140                 If .BufLen <= 0 Then GoTo errExit ‘读取出错
141                 
142                 ‘----初始化缓冲区指针
143                 .PtrInBuf = 1
144                 ‘看是否需要忽略第一个 vbLf
145                 If .IgnoreFirstLf Then
146                     If .bufBytes(.PtrInBuf) = 10 Then ‘第1个字节确是 vbLf
147                         ‘忽略第一个 vbLf
148                         .PtrInBuf = .PtrInBuf + 1
149                         lEndLineSignLast = 2573 ‘上次的分行符为 vbCrLf
150                     Else
151                         ‘第1个字节不是 vbLf，而因为要忽略第1个 vbLf _
152                           ‘说明上一行最后是 vbCr，故设置上一行分行符为 vbCr
153                         lEndLineSignLast = 13
154                     End If ‘If .bufBytes(.PtrInBuf) = 10 Then
155                     
156                     .IgnoreFirstLf = False ‘恢复标志，不忽略第一个 vbLf
157                 End If ‘If .IgnoreFirstLf Then
158                 
159                 ‘初始化下一行起始位置 ptrNextStrStartInBuf （下一行内容包含该字节）
160                 .ptrNextStrStartInBuf = .PtrInBuf
161             End If ‘If .PtrInBuf < 0 Then
162             
163             ‘============ （2）逐个扫描缓冲区中的字节，查找分行符 ============
164             ‘扫描缓冲区中的字节，直到找到 vbCr或vbLf 或扫描完缓冲区
165             For .PtrInBuf = .PtrInBuf To .BufLen
166                 ch = .bufBytes(.PtrInBuf)
167                 Select Case State ‘34代表双引号 44代表逗号
168                     Case NewFieldStart
169                         If ch = 34 Then
170                             State = QuotesField
171                         ElseIf ch = 44 Then
172                             lineArr.Add ""
173                             State = FieldSeparator
174                         ElseIf ch = 13 Or ch = 10 Then
175                             State = NewFieldStart
176                             Exit For
177                         Else
178 
179                             strArrlBuff = strArrlBuff + 1
180                             If strArrlBuff Mod mcInitBuffSize = 0 Then
181                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
182                             End If
183                             ‘ReDim Preserve strArr(1 To strArrlBuff)
184                             strArr(strArrlBuff) = ch
185                             ‘strArr.Add ch
186                             State = NonQuotesField
187                         End If
188                     Case NonQuotesField
189                         If ch = 44 Then
190                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr
191                             Erase strArr
192                             ReDim strArr(1 To mcInitBuffSize)
193                             strArrlBuff = 0
194                             ‘Set strArr = New Collection
195                             State = FieldSeparator
196                         ElseIf ch = 13 Then
197                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr
198                             State = RowSeparator
199                         Else
200                             strArrlBuff = strArrlBuff + 1
201                             If strArrlBuff Mod mcInitBuffSize = 0 Then
202                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
203                             End If
204                             ‘ReDim Preserve strArr(1 To strArrlBuff)
205                             strArr(strArrlBuff) = ch
206                             ‘strArr.Add ch
207                         End If
208                     Case QuotesField
209                         If ch = 34 Then
210                             State = QuoteInQuotesField
211                         Else
212                             strArrlBuff = strArrlBuff + 1
213                             If strArrlBuff Mod mcInitBuffSize = 0 Then
214                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
215                             End If
216                             ‘ReDim Preserve strArr(1 To strArrlBuff)
217                             strArr(strArrlBuff) = ch
218                             ‘strArr.Add ch
219                         End If
220                     Case FieldSeparator
221                         If ch = 44 Then
222                             lineArr.Add ""
223                         ElseIf ch = 34 Then
224                             Erase strArr
225                             ReDim strArr(1 To mcInitBuffSize)
226                             strArrlBuff = 0
227                             ‘Set strArr = New Collection
228                             State = QuotesField
229                         ElseIf ch = 13 Then
230                             lineArr.Add ""
231                             State = RowSeparator
232                         Else
233                             strArrlBuff = strArrlBuff + 1
234                             If strArrlBuff Mod mcInitBuffSize = 0 Then
235                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
236                             End If
237                             ‘ReDim Preserve strArr(1 To strArrlBuff)
238                             strArr(strArrlBuff) = ch
239                             ‘strArr.Add ch
240                             State = NonQuotesField
241                         End If
242                     Case QuoteInQuotesField
243                         If ch = 44 Then
244                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr
245                             Erase strArr
246                             ReDim strArr(1 To mcInitBuffSize)
247                             strArrlBuff = 0
248                             ‘Set strArr = New Collection
249                             State = FieldSeparator
250                         ElseIf ch = 13 Then
251                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr
252                             State = RowSeparator
253                         ElseIf ch = 34 Then
254                             strArrlBuff = strArrlBuff + 1
255                             If strArrlBuff Mod mcInitBuffSize = 0 Then
256                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)
257                             End If
258                             ‘ReDim Preserve strArr(1 To strArrlBuff)
259                             strArr(strArrlBuff) = ch
260                             ‘strArr.Add ch
261                             State = QuotesField
262                         Else
263                             State = ErrorS ‘"语法错误： 转义字符 \" 不能完成转义 或 引号字段结尾引号没有紧贴字段分隔符";
264                         End If
265                     Case RowSeparator
266                         If ch = 10 Then
267                             Erase strArr
268                             ReDim strArr(1 To mcInitBuffSize)
269                             strArrlBuff = 0
270                             ‘Set strArr = New Collection
271                             State = NewFieldStart
272                             Exit For
273                         Else
274                             State = ErrorS ‘"语法错误： 行分隔用了回车 \\r。但未使用回车换行 \\r\\n ";
275                         End If
276                     Case ErrorS
277                         GoTo errExit
278                                             
279                 End Select
280 
281 ‘                If .bufBytes(.PtrInBuf) = 13 Or _
282 ‘                 .bufBytes(.PtrInBuf) = 10 Then Exit For
283             Next .PtrInBuf
284             
285             ‘退出 For 后，判断是否找到了分行符 vbCr或vbLf
286             If .PtrInBuf <= .BufLen Then  ‘是否找到了 vbCr或vbLf
287             
288                 ‘============ （3）找到一个分行符 vbCr或vbLf ============
289                 ‘本行读到位置：af_Buff.PtrInBuf - 1
290                 
291                 ‘---- 设置本行换行符 ----
292                 lEndLineSign = .bufBytes(.PtrInBuf)
293                 
294                 ‘---- 生成要返回的本行字符串到：af_strBuf ----
295                 If .PtrInBuf - .ptrNextStrStartInBuf + af_LastBuff.LeftBLen < 1 Then
296                     ‘.PtrInBuf = .ptrNextStrStartInBuf 时，例如 .PtrInBuf
297                       ‘= .ptrNextStrStartInBuf=1 时，即开始就是 vbCr/vbLf
298                     af_strBuf = ""
299                 Else
300                     ‘-- 将要返回的字符串的所有字节：包括上次剩余的 和 本次到 _
301                       ‘.PtrInBuff 的(不算 .PtrInBuff 位置的)全部存入 af_bytsBuf() 数组 --
302                     ReDim af_bytsBuf(1 To .PtrInBuf - .ptrNextStrStartInBuf + af_LastBuff.LeftBLen)
303                     
304                     ‘先保存上次剩余的字节 LeftBytes，存到 af_bytsBuf 的开始
305                     With af_LastBuff
306                         For j = 1 To .LeftBLen
307                             af_bytsBuf(j) = .LeftBytes(j)
308                         Next j
309                     End With
310                     
311                     ‘再加上本次范围：[.ptrNextStrStartInBuf,.PtrInBuf) 的字节， _
312                       ‘不包含 .PtrInBuf，因为 .PtrInBuf 是 vbCr/vbLf
313                     For j = 1 To .PtrInBuf - .ptrNextStrStartInBuf
314                         af_bytsBuf(j + af_LastBuff.LeftBLen) = _
315                           .bufBytes(.ptrNextStrStartInBuf + j - 1)
316                     Next j
317 
318                     ‘-- 将 af_bytsBuf 中的字节转换为字符串到： af_strBuf --
319                     ‘af_strBuf = af_bytsBuf
320 
321                     af_strBuf = EncodeStr(af_bytsBuf, EncodeErr) ‘代码转换
322                     If EncodeErr Then  ‘代码转换出错
323                         GoTo errExit
324                     End If
325                     
326                     If lTrimSpaces Then af_strBuf = Trim(af_strBuf)
327                     
328                     ‘-- 清除上次剩余的字节缓冲区 LeftBytes --
329                     Erase af_LastBuff.LeftBytes
330                     af_LastBuff.LeftBLen = 0
331                 End If
332                 
333                 ‘---- 判断是否是连续的 vbCr+vbLf，若是，跳过下一个 vbLf ----
334                 If .bufBytes(.PtrInBuf) = 13 Then
335                     If .PtrInBuf + 1 > .BufLen Then
336                         ‘如果下一个字节已经超过这个缓冲区，则无法判断下一个字节 _
337                           ‘是否是 vbLf，这里只设置标志，以后判断是否 vbLf 并决定跳过
338                         .IgnoreFirstLf = True
339                         lEndLineSign = -1
340                     Else
341                         ‘下一个字节没超过这个缓冲区，下一个字节若是 vbLf 则直接跳过
342                         If .bufBytes(.PtrInBuf + 1) = 10 Then
343                             .PtrInBuf = .PtrInBuf + 1
344                             lEndLineSign = 2573
345                         End If
346                     End If
347                 End If
348                 
349                 ‘---- 设置当前缓冲区内部的下一行的起始位置 ----
350                 ‘注：这里还未使 .PtrInBuf + 1
351                 .ptrNextStrStartInBuf = .PtrInBuf + 1 ‘下一行字符包括这个字节
352                 
353                 ‘---- 返回：判断是否已经读完文件 ----
354                 ‘.PtrInBuf 要 + 1 参与判断，因为本次循环后 .PtrInBuf 要 +1，现在还未 +1
355                 ‘是否读完文件的标志存到 lIsEndRead，出 if 后据此决定返回值
356                 If .PtrInBuf + 1 > .BufLen And _
357                   .StartPosAbso + .BufLen > af_lngFileLength Then
358                     ‘已经读完文件
359                     lIsEndRead = True
360                     If lAutoClose Then CloseFile
361                 Else
362                     ‘还未读完文件，再判断是否文件只剩一个字节；若只剩一个字节并且 _
363                       ‘剩下的正好是 vbLf，并且下次要忽略掉 vbLf，则仍是已经读完文件
364                     If .StartPosAbso + .BufLen = af_lngFileLength And .IgnoreFirstLf Then
365                         ‘读取文件中的最后一个字节，只测试一下
366                         Dim tByt() As Byte, tRet As Integer
367                         tRet = FileGetBytesLocal(.StartPosAbso + .BufLen, tByt())
368                         If tRet <= 0 Then GoTo errExit ‘出错处理
369                         If tByt(1) = 10 Then
370                             ‘已经读完文件
371                             lEndLineSign = 2573
372                             lIsEndRead = True
373                             If lAutoClose Then CloseFile
374                         End If
375                     End If
376                 End If
377                 .PtrInBuf = .PtrInBuf + 1
378                 
379                 ‘找到了 vbCr/vbLf 返回这一行到：RetString，并退出函数 _
380                 ‘但在退出前判断忽略空行，如果是空行就不退出而继续 Loop
381                 If lIsEndRead Then
382                     ‘已经读完文件，一定 Exit Function
383                     RetString = af_strBuf
384                     Set col = lineArr
385                     Set lineArr = New Collection
386                     strArrlBuff = 0
387                     If lIgnoreEmpty And Len(af_strBuf) = 0 Then
388                         ‘需要忽略空行，且最后一行为空行返回0，但不属于错误
389                         GetNextLine = 0
390                     Else
391                         ‘不需要忽略空行或最后不是空行，但读完了文件，_
392                           ‘不是返回1而是返回-1
393                         GetNextLine = -1
394                     End If
395                     Exit Function ‘已经读完文件，一定 Exit Function
396                 Else ‘If lIsEndRead Then
397                     ‘没有读完文件(忽略空行不退出，否则退出)
398                     If lIgnoreEmpty And Len(af_strBuf) = 0 Then
399                         ‘忽略空行，不 Exit Function
400                         
401                     Else
402                         ‘不需要忽略空行或最后不是空行，退出
403                         RetString = af_strBuf
404                         Set col = lineArr
405                         Set lineArr = New Collection
406                         strArrlBuff = 0
407                         GetNextLine = 1
408                         Exit Function
409                     End If
410                 End If ‘If lIsEndRead Then
411                 
412             Else ‘If .PtrInBuf <= .BufLen Then ‘是否找到了 vbCr或vbLf
413                 ‘============ （4）没有找到分行符“vbCr或vbLf”的处理 ============
414                 ‘设置标志，=-1 表示下次要重新读取新的缓冲区， _
415                   ‘否则不重新读取，仍使用当前缓冲区和 .PtrInBuf 指针
416                 .PtrInBuf = -1
417                 
418                 ‘==== 看缓冲区中是否还有剩余未处理的字节，若有， _
419                   ‘将剩余的存入 af_LastBuff.LeftBytes() ====
420                 If .ptrNextStrStartInBuf <= .BufLen Then
421                     ReDim Preserve af_LastBuff.LeftBytes(1 To _
422                       .BufLen - .ptrNextStrStartInBuf + 1 + af_LastBuff.LeftBLen)
423                     For j = 1 To .BufLen - .ptrNextStrStartInBuf + 1
424                         af_LastBuff.LeftBytes(j + af_LastBuff.LeftBLen) _
425                           = .bufBytes(.ptrNextStrStartInBuf + j - 1)
426                     Next j
427                     af_LastBuff.LeftBLen = .BufLen - _
428                       .ptrNextStrStartInBuf + 1 + af_LastBuff.LeftBLen
429                 End If
430                 
431                 ‘==== 准备继续读下一个缓冲区 ====
432                 .StartPosAbso = .StartPosAbso + .BufLen
433             End If ‘If .PtrInBuf <= .BufLen Then ‘是否找到了 vbCr或vbLf
434         Loop
435     End With
436     
437     
438     ‘//////////// 全部读完文件，看还有无剩余的 ////////////
439     If af_LastBuff.LeftBLen > 0 Then
440         
441         Select Case State
442             Case NonQuotesField
443                  lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr
444                  Erase strArr
445                  ReDim strArr(1 To mcInitBuffSize)
446                  strArrlBuff = 0
447                  ‘lineArr.Add strArr
448                  ‘Set strArr = New Collection
449             Case QuotesField
450                  GoTo errExit ‘"语法错误： 引号字段未闭合";
451             Case FieldSeparator
452                 lineArr.Add ""
453             Case QuoteInQuotesField
454                 lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr
455                 
456         End Select
457         
458         ‘af_strBuf = af_LastBuff.LeftBytes
459         af_strBuf = EncodeStr(af_LastBuff.LeftBytes, EncodeErr)  ‘代码转换
460         If EncodeErr Then ‘代码转换出错
461             GoTo errExit
462         End If
463         
464         ‘af_strBuf = StrConv(af_strBuf, vbUnicode)
465         If lTrimSpaces Then af_strBuf = Trim(af_strBuf)
466         RetString = af_strBuf
467         Set col = lineArr
468         Set lineArr = New Collection
469         strArrlBuff = 0
470         
471         Erase af_LastBuff.LeftBytes
472         af_LastBuff.LeftBLen = 0
473         If lIgnoreEmpty And Len(af_strBuf) = 0 Then
474             GetNextLine = 0
475         Else
476             GetNextLine = -1
477         End If
478         
479         If lAutoClose Then CloseFile
480         lEndLineSign = -2
481         lIsEndRead = True
482         ‘此时读完文件，必须返回
483         Exit Function
484     End If
485     
486 
487 errExit:
488     lErrOccured = True
489     lEndLineSign = 0
490     GetNextLine = 0
491     ‘为一般错误，不设置 lIsEndRead = True
492     If lAutoClose Then CloseFile
493 End Function
494 
495 Private Function EncodeStr(ByRef bytIn() As Byte, hasError As Boolean, Optional byteSize As Long = -1) As String
496 
497     Select Case Encode
498         Case Default
499             Dim tempStr As String
500             tempStr = bytIn
501             EncodeStr = StrConv(tempStr, vbUnicode)
502 
503         Case ShifJis
504             EncodeStr = WCMB_Decode(ShifJis, bytIn, hasError, byteSize)
505         Case JIS
506              EncodeStr = WCMB_Decode(JIS, bytIn, hasError, byteSize)
507         Case Utf8
508             EncodeStr = WCMB_Decode(Utf8, bytIn, hasError, byteSize)
509         Case GB2312
510              EncodeStr = WCMB_Decode(GB2312, bytIn, hasError, byteSize)
511     End Select
512 
513 End Function
514 
515 
516 ‘ 関数名    : WCMB_Decode
517 ‘ 返り値    : UNICODE文字列
518 ‘ 引き数    : cp    : 入力文字データのコードページ番号
519 ‘           : bytIn : 入力文字データ
520 ‘ 機能説明  : 入力文字データをUNICODEに変換する
521 ‘ 備考      : MultiByteToWideCharによる文字コード変換
522 Private Function WCMB_Decode(ByVal cp As Long, ByRef bytIn() As Byte, ByRef hasError As Boolean, Optional byteSize As Long = -1) As String
523     On Error GoTo ErrHandler
524 
525     Dim lngInSize As Long
526     Dim strBuf As String
527     Dim lngBufLen As Long
528     Dim lngRtn As Long
529     If byteSize > 0 Then
530         lngInSize = byteSize
531     Else
532         If bytIn(UBound(bytIn)) = 13 Then
533             lngInSize = UBound(bytIn) - 1
534         Else
535             lngInSize = UBound(bytIn)
536         End If
537     End If
538     lngBufLen = (lngInSize + 1) * 5
539     strBuf = String$(lngBufLen, vbNullChar)
540     lngRtn = MultiByteToWideChar _
541         (cp, 0, bytIn(1), lngInSize, StrPtr(strBuf), lngBufLen)
542     If lngRtn Then
543         WCMB_Decode = Left$(strBuf, lngRtn)
544     End If
545     hasError = False
546     Exit Function
547 ErrHandler:
548     WCMB_Decode = ""
549     hasError = True
550 End Function
551 
552 Public Sub Init()
553 
554     ReDim strArr(1 To mcInitBuffSize) ‘CSV 各个单元 缓冲区
555     strArrlBuff = 0
556                  
557     Erase af_Buff.bufBytes ‘缓冲区
558     
559     Erase af_LastBuff.LeftBytes
560     af_LastBuff.LeftBLen = 0
561     
562     af_strBuf = ""
563     af_lngFileLength = 0
564     af_Buff.StartPosAbso = 1 ‘当前缓冲区的起始处所在的文件位置
565     af_Buff.ptrNextStrStartInBuf = 1
566     
567     ‘此作为标志，=-1表示下次运行 GetNextLine 要重新读取新的缓冲区 _
568       ‘否则不重新读取，仍使用当前缓冲区和 .PtrInBuf 指针
569     af_Buff.PtrInBuf = -1
570     
571     af_OneEndRead = True ‘设置标志：关闭后再调用一次 GetNextLine 不出错
572     lErrOccured = False
573     lEndLineSign = 0
574     lEndLineSignLast = 0
575     
576     af_Buff.IgnoreFirstLf = False ‘初始化标志：当前缓冲区不需要忽略第一个字节（若是vblf）
577     
578     lIsEndRead = False
579 End Sub
580 
581 Public Function GetPercent(Optional DotNum As Integer = 2) As Single
582     ‘DotNum保留几位小数，<0或>7为不保留小数
583     Dim sngPerc As Single
584     
585     If af_lngFileLength > 0 Then
586         If af_Buff.PtrInBuf < 0 Then
587             sngPerc = (af_Buff.StartPosAbso - 1) / af_lngFileLength
588         Else
589             sngPerc = (af_Buff.StartPosAbso + af_Buff.PtrInBuf - 2) / af_lngFileLength
590         End If
591     End If
592     
593     If DotNum >= 0 Or DotNum <= 7 Then
594         Dim Temp As Long
595         Temp = 10 ^ DotNum
596         sngPerc = Int(Temp * sngPerc + 0.5) / Temp
597     End If
598     
599     GetPercent = sngPerc
600 End Function
601 
602 Public Sub CloseFile()
603     If lFileNum > 0 Then Close lFileNum: lFileNum = 0
604     lStatus = -1 ‘表示文件已关闭
605     ‘不Init，防止读取行后自动关闭文件时状态变量被初始化；在OpenFile时会Init
606 End Sub
607 
608 Public Function OpenFile() As Boolean
609     If lFileNum > 0 Then CloseFile ‘如果已打开了文件，则先关闭它
610     lFileNum = FreeFile ‘获得一个可用的文件号（同时属性 FileNum 的值也自动改变）
611     On Error GoTo errH ‘如果一下程序发生任何错误，就转到 errH 标签处执行
612     If Dir(lFileName, 31) = "" Then GoTo errH ‘如果文件不存在，就转到 errH 标签处执行
613     Open lFileName For Binary Access Read As #lFileNum ‘以二进制方式打开文件
614     lStatus = 1 ‘表示文件已打开
615     Init ‘初始化操作
616     af_lngFileLength = LOF(lFileNum) ‘设置文件总大小
617     OpenFile = True
618     Exit Function
619 errH:
620     If lFileNum > 0 Then CloseFile
621     OpenFile = False
622 End Function
623 
624 
625 
626 Private Function FileGetBytesLocal(ByVal ReadPos As Long, _
627                                          ArrBytes() As Byte, _
628                           Optional ByVal EndingBorder As Long = 0, _
629                           Optional ByVal ReadMax As Long = 16384) As Long
630                           ‘Optional ByVal ReadMax As Long = 16384, _
631     ‘从文件号 lFileNum 中的 ReadPos 位置开始读取一批字节
632     ‘从参数ArrBytes()返回读取的字节内容，会重新定义ArrBytes()数组
633     ‘所读取的字节数不确定，如果文件中有足够的内容，就读取ReadMax个字节， _
634       ‘否则就读到文件尾（当EndingBorder参数<=0时）或读到EndingBorder _
635       ‘为止（当EndingBorder参数>0时）
636     ‘ShowResume 指定如果读取出错，是否弹出对话框提示
637       ‘若ShowResume=1，提示框中有"重试"和"取消"两个按钮；
638       ‘若ShowResume=2，出错时提示框中有"终止"、"重试"和"忽略"三个按钮；
639       ‘若ShowResume=0，出错时不弹出提示框，不弹出提示框就不能在发生错误时重试
640     ‘返回读取的字节数，若失败返回<=0，若用户“忽略”则返回=0；_
641       ‘若用户终止或取消或无提示框，则返回<0
642     
643     Dim lngUBound As Long
644     
645     If EndingBorder <= 0 Then EndingBorder = LOF(lFileNum)
646     If EndingBorder < ReadPos Then
647         FileGetBytesLocal = -1
648         Exit Function
649     End If
650     
651     On Error GoTo errH
652     If EndingBorder - ReadPos + 1 >= ReadMax Then lngUBound = ReadMax Else _
653       lngUBound = EndingBorder - ReadPos + 1
654     
655     ReDim ArrBytes(1 To lngUBound) As Byte
656     
657     Get #FileNum, ReadPos, ArrBytes
658 
659     FileGetBytesLocal = lngUBound
660     Exit Function
661 errH:
662      FileGetBytesLocal = -1
663 End Function
664 
665 
666 
667 Private Sub Class_Initialize()
668     lAutoOpen = True ‘设置 FileName 属性时自动打开文件
669     lAutoClose = True ‘读取行读完文件或出错时 自动关闭文件
670     lTrimSpaces = False ‘不自动Trim()结果行
671     lIgnoreEmpty = True ‘是否自动忽略空行（注意：如果是最后一行仍可能返回空行）
672 End Sub
673 
674 Private Sub Class_Terminate()
675     CloseFile
676     Erase af_Buff.bufBytes
677     Erase af_LastBuff.LeftBytes
678     Erase af_bytsBuf
679 End Sub
680 
681 
682 Public Property Get FileName() As String
683     FileName = lFileName
684 End Property
685 
686 Public Property Let FileName(ByVal vNewValue As String)
687     If lFileNum > 0 Then CloseFile
688     lFileName = vNewValue
689     If lAutoOpen Then OpenFile
690 End Property
691 
692 Public Property Get FileNum() As Integer
693     FileNum = lFileNum
694 End Property
695 
696 Public Property Get Status() As Integer
697     Status = lStatus
698 End Property
699 
700 Public Property Get IsEndRead() As Boolean
701     IsEndRead = lIsEndRead
702 End Property
703 
704 
705 Public Property Get TrimSpaces() As Boolean
706     TrimSpaces = lTrimSpaces
707 End Property
708 
709 Public Property Let TrimSpaces(ByVal vNewValue As Boolean)
710     lTrimSpaces = vNewValue
711 End Property
712 
713 Public Property Get AutoOpen() As Boolean
714     AutoOpen = lAutoOpen
715 End Property
716 
717 Public Property Let AutoOpen(ByVal vNewValue As Boolean)
718     lAutoOpen = vNewValue
719 End Property
720 
721 Public Property Get AutoClose() As Boolean
722     AutoClose = lAutoClose
723 End Property
724 
725 Public Property Let AutoClose(ByVal vNewValue As Boolean)
726     lAutoClose = vNewValue
727 End Property
728 
729 Public Property Get IgnoreEmpty() As Boolean ‘是否自动忽略空行 ""
730     IgnoreEmpty = lIgnoreEmpty
731 End Property
732 
733 Public Property Let IgnoreEmpty(ByVal vNewValue As Boolean)
734     lIgnoreEmpty = vNewValue
735 End Property
736 
737 Public Property Get EndLineSign() As Integer
738     EndLineSign = lEndLineSign
739 End Property
740 
741 Public Property Get EndLineSignLast() As Integer
742     EndLineSignLast = lEndLineSignLast
743 End Property
744 
745 Public Property Get ErrOccured() As Boolean
746     ErrOccured = lErrOccured
747 End Property
748 
749 Public Property Let ErrOccured(ByVal vNewValue As Boolean)
750     lErrOccured = vNewValue
751 End Property
752 
753 Public Property Get Encode() As EncodeEnum
754     Encode = lEncode
755 End Property
756 
757 Public Property Let Encode(ByVal vNewValue As EncodeEnum)
758     lEncode = vNewValue
759 End Property
760 
761 Public Property Get IsEncodeErr() As Boolean
762     IsEncodeErr = EncodeErr
763 End Property