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_Buff106         ‘缓冲区逐渐沿文件前进，直到缓冲区起始位置超过文件总长读完文件107         Do Until .StartPosAbso > af_lngFileLength108         109             ‘============ （1）根据需要读取文件的下一个缓冲区内容 ============110             ‘若 .PtrInBuf=-1 表示要读取下一个缓冲区，否则不读取下一个，仍使用 _111               当前缓冲区和 .PtrInBuf 指针112             If .PtrInBuf < 0 Then113                 ‘----从 .StartPosAbso 开始读取一些字节存入缓冲区 .bufBytes()114                 .BufLen = FileGetBytesLocal(.StartPosAbso, .bufBytes())115                 If .BufLen <= 0 Then GoTo errExit ‘读取出错116                 117                 ‘----初始化缓冲区指针118                 .PtrInBuf = 1119                 ‘看是否需要忽略第一个 vbLf120                 If .IgnoreFirstLf Then121                     If .bufBytes(.PtrInBuf) = 10 Then ‘第1个字节确是 vbLf122                         ‘忽略第一个 vbLf123                         .PtrInBuf = .PtrInBuf + 1124                     End If ‘If .bufBytes(.PtrInBuf) = 10 Then125                     126                     .IgnoreFirstLf = False ‘恢复标志，不忽略第一个 vbLf127                 End If ‘If .IgnoreFirstLf Then128                 129                 ‘初始化下一行起始位置 ptrNextStrStartInBuf （下一行内容包含该字节）130                 .ptrNextStrStartInBuf = .PtrInBuf131             End If ‘If .PtrInBuf < 0 Then132             133             ‘============ （2）逐个扫描缓冲区中的字节，查找分行符 ============134             ‘扫描缓冲区中的字节，直到找到 vbCr或vbLf 或扫描完缓冲区135             For .PtrInBuf = .PtrInBuf To .BufLen136                 ch = .bufBytes(.PtrInBuf)137                 Select Case State ‘34代表双引号 44代表逗号138                     Case NewFieldStart139                         If ch = 34 Then140                             State = QuotesField141                         ElseIf ch = 44 Then142                             lineArr.Add ""143                             State = FieldSeparator144                         ElseIf ch = 13 Or ch = 10 Then145                             State = NewFieldStart146                             Exit For147                         Else148 149                             strArrlBuff = strArrlBuff + 1150                             If strArrlBuff Mod mcInitBuffSize = 0 Then151                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)152                             End If153                             ‘ReDim Preserve strArr(1 To strArrlBuff)154                             strArr(strArrlBuff) = ch155                             ‘strArr.Add ch156                             State = NonQuotesField157                         End If158                     Case NonQuotesField159                         If ch = 44 Then160                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr161                             Erase strArr162                             ReDim strArr(1 To mcInitBuffSize)163                             strArrlBuff = 0164                             ‘Set strArr = New Collection165                             State = FieldSeparator166                         ElseIf ch = 13 Then167                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr168                             State = RowSeparator169                         Else170                             strArrlBuff = strArrlBuff + 1171                             If strArrlBuff Mod mcInitBuffSize = 0 Then172                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)173                             End If174                             ‘ReDim Preserve strArr(1 To strArrlBuff)175                             strArr(strArrlBuff) = ch176                             ‘strArr.Add ch177                         End If178                     Case QuotesField179                         If ch = 34 Then180                             State = QuoteInQuotesField181                         Else182                             strArrlBuff = strArrlBuff + 1183                             If strArrlBuff Mod mcInitBuffSize = 0 Then184                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)185                             End If186                             ‘ReDim Preserve strArr(1 To strArrlBuff)187                             strArr(strArrlBuff) = ch188                             ‘strArr.Add ch189                         End If190                     Case FieldSeparator191                         If ch = 44 Then192                             lineArr.Add ""193                         ElseIf ch = 34 Then194                             Erase strArr195                             ReDim strArr(1 To mcInitBuffSize)196                             strArrlBuff = 0197                             ‘Set strArr = New Collection198                             State = QuotesField199                         ElseIf ch = 13 Then200                             lineArr.Add ""201                             State = RowSeparator202                         Else203                             strArrlBuff = strArrlBuff + 1204                             If strArrlBuff Mod mcInitBuffSize = 0 Then205                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)206                             End If207                             ‘ReDim Preserve strArr(1 To strArrlBuff)208                             strArr(strArrlBuff) = ch209                             ‘strArr.Add ch210                             State = NonQuotesField211                         End If212                     Case QuoteInQuotesField213                         If ch = 44 Then214                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr215                             Erase strArr216                             ReDim strArr(1 To mcInitBuffSize)217                             strArrlBuff = 0218                             ‘Set strArr = New Collection219                             State = FieldSeparator220                         ElseIf ch = 13 Then221                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr222                             State = RowSeparator223                         ElseIf ch = 34 Then224                             strArrlBuff = strArrlBuff + 1225                             If strArrlBuff Mod mcInitBuffSize = 0 Then226                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)227                             End If228                             ‘ReDim Preserve strArr(1 To strArrlBuff)229                             strArr(strArrlBuff) = ch230                             ‘strArr.Add ch231                             State = QuotesField232                         Else233                             State = ErrorS ‘"语法错误： 转义字符 \" 不能完成转义 或 引号字段结尾引号没有紧贴字段分隔符";234                         End If235                     Case RowSeparator236                         If ch = 10 Then237                             Erase strArr238                             ReDim strArr(1 To mcInitBuffSize)239                             strArrlBuff = 0240                             ‘Set strArr = New Collection241                             State = NewFieldStart242                             Exit For243                         Else244                             State = ErrorS ‘"语法错误： 行分隔用了回车 \\r。但未使用回车换行 \\r\\n ";245                         End If246                     Case ErrorS247                         GoTo errExit248                                             249                 End Select250 251 ‘                If .bufBytes(.PtrInBuf) = 13 Or _252 ‘                 .bufBytes(.PtrInBuf) = 10 Then Exit For253             Next .PtrInBuf254             255             ‘退出 For 后，判断是否找到了分行符 vbCr或vbLf256             If .PtrInBuf <= .BufLen Then  ‘是否找到了 vbCr或vbLf257                 If .PtrInBuf + 1 > .BufLen And _258                   .StartPosAbso + .BufLen > af_lngFileLength Then259                     ‘已经读完文件260                     lIsEndRead = True261                     If lAutoClose Then CloseFile262                 Else263                     ‘还未读完文件，再判断是否文件只剩一个字节；若只剩一个字节并且 _264                       ‘剩下的正好是 vbLf，并且下次要忽略掉 vbLf，则仍是已经读完文件265                     If .StartPosAbso + .BufLen = af_lngFileLength And .IgnoreFirstLf Then266                         ‘读取文件中的最后一个字节，只测试一下267                         Dim tByt() As Byte, tRet As Integer268                         tRet = FileGetBytesLocal(.StartPosAbso + .BufLen, tByt())269                         If tRet <= 0 Then GoTo errExit ‘出错处理270                         If tByt(1) = 10 Then271                             ‘已经读完文件272                             lIsEndRead = True273                             If lAutoClose Then CloseFile274                         End If275                     End If276                 End If277                 .PtrInBuf = .PtrInBuf + 1278             279                 If lIsEndRead Then280                     ‘已经读完文件，一定 Exit Function281                     282                     Set col = lineArr283                     Set lineArr = New Collection284                     strArrlBuff = 0285                     GetNextLine = 0286                     287                     Exit Function ‘已经读完文件，一定 Exit Function288                 Else ‘If lIsEndRead Then289                     ‘没有读完文件(忽略空行不退出，否则退出)290                         If GetNextLine = 0 Then291                         ‘不需要忽略空行或最后不是空行，退出292                         Else293                             Set col = lineArr294                             Set lineArr = New Collection295                             strArrlBuff = 0296                             GetNextLine = 1297                             Exit Function298                         End If299                 End If ‘If lIsEndRead Then300                 301             Else ‘If .PtrInBuf <= .BufLen Then ‘是否找到了 vbCr或vbLf302                  303                  .PtrInBuf = -1304                 ‘==== 准备继续读下一个缓冲区 ====305                 .StartPosAbso = .StartPosAbso + .BufLen306             End If ‘If .PtrInBuf <= .BufLen Then ‘是否找到了 vbCr或vbLf307         Loop308     End With309     310     311     ‘//////////// 全部读完文件，看还有无剩余的 ////////////312    313         314         Select Case State315             Case NonQuotesField316                  lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr317                  Erase strArr318                  ReDim strArr(1 To mcInitBuffSize)319                  strArrlBuff = 0320                  ‘lineArr.Add strArr321                  ‘Set strArr = New Collection322             Case QuotesField323                  GoTo errExit ‘"语法错误： 引号字段未闭合";324             Case FieldSeparator325                 lineArr.Add ""326             Case QuoteInQuotesField327                 lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr328                 329         End Select330         331 332         Set col = lineArr333         Set lineArr = New Collection334         strArrlBuff = 0335 336         GetNextLine = 0337 338         339         If lAutoClose Then CloseFile340         lIsEndRead = True341         ‘此时读完文件，必须返回342         Exit Function343 344     345 346 errExit:347     lErrOccured = True348     GetNextLine = 0349     ‘为一般错误，不设置 lIsEndRead = True350     If lAutoClose Then CloseFile351 End Function352 353 Private Function EncodeStr(ByRef bytIn() As Byte, hasError As Boolean, Optional byteSize As Long = -1) As String354 355     Select Case Encode356         Case Default357             Dim tempStr As String358             tempStr = bytIn359             EncodeStr = StrConv(tempStr, vbUnicode)360 361         Case ShifJis362             EncodeStr = WCMB_Decode(ShifJis, bytIn, hasError, byteSize)363         Case JIS364              EncodeStr = WCMB_Decode(JIS, bytIn, hasError, byteSize)365         Case Utf8366             EncodeStr = WCMB_Decode(Utf8, bytIn, hasError, byteSize)367         Case GB2312368              EncodeStr = WCMB_Decode(GB2312, bytIn, hasError, byteSize)369     End Select370 371 End Function372 373 374 ‘ 関数名    : WCMB_Decode375 ‘ 返り値    : 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 String381     On Error GoTo ErrHandler382 383     Dim lngInSize As Long384     Dim strBuf As String385     Dim lngBufLen As Long386     Dim lngRtn As Long387     If byteSize > 0 Then388         lngInSize = byteSize389     Else390         If bytIn(UBound(bytIn)) = 13 Then391             lngInSize = UBound(bytIn) - 1392         Else393             lngInSize = UBound(bytIn)394         End If395     End If396     lngBufLen = (lngInSize + 1) * 5397     strBuf = String$(lngBufLen, vbNullChar)398     lngRtn = MultiByteToWideChar _399         (cp, 0, bytIn(1), lngInSize, StrPtr(strBuf), lngBufLen)400     If lngRtn Then401         WCMB_Decode = Left$(strBuf, lngRtn)402     End If403     hasError = False404     Exit Function405 ErrHandler:406     WCMB_Decode = ""407     hasError = True408 End Function409 410 Public Sub Init()411 412     ReDim strArr(1 To mcInitBuffSize) ‘CSV 各个单元 缓冲区413     strArrlBuff = 0414                  415     Erase af_Buff.bufBytes ‘缓冲区416     417     418 419     af_lngFileLength = 0420     af_Buff.StartPosAbso = 1 ‘当前缓冲区的起始处所在的文件位置421     af_Buff.ptrNextStrStartInBuf = 1422     423     ‘此作为标志，=-1表示下次运行 GetNextLine 要重新读取新的缓冲区 _424       ‘否则不重新读取，仍使用当前缓冲区和 .PtrInBuf 指针425     af_Buff.PtrInBuf = -1426     427     lErrOccured = False428 429     430     af_Buff.IgnoreFirstLf = False ‘初始化标志：当前缓冲区不需要忽略第一个字节（若是vblf）431     432     lIsEndRead = False433 End Sub434 435 Public Function GetPercent(Optional DotNum As Integer = 2) As Single436     ‘DotNum保留几位小数，<0或>7为不保留小数437     Dim sngPerc As Single438     439     If af_lngFileLength > 0 Then440         If af_Buff.PtrInBuf < 0 Then441             sngPerc = (af_Buff.StartPosAbso - 1) / af_lngFileLength442         Else443             sngPerc = (af_Buff.StartPosAbso + af_Buff.PtrInBuf - 2) / af_lngFileLength444         End If445     End If446     447     If DotNum >= 0 Or DotNum <= 7 Then448         Dim Temp As Long449         Temp = 10 ^ DotNum450         sngPerc = Int(Temp * sngPerc + 0.5) / Temp451     End If452     453     GetPercent = sngPerc454 End Function455 456 Public Sub CloseFile()457     If lFileNum > 0 Then Close lFileNum: lFileNum = 0458     lStatus = -1 ‘表示文件已关闭459     ‘不Init，防止读取行后自动关闭文件时状态变量被初始化；在OpenFile时会Init460 End Sub461 462 Public Function OpenFile() As Boolean463     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 = True472     Exit Function473 errH:474     If lFileNum > 0 Then CloseFile475     OpenFile = False476 End Function477 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 Long484                           ‘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       ‘若用户终止或取消或无提示框，则返回<0496     497     Dim lngUBound As Long498     499     If EndingBorder <= 0 Then EndingBorder = LOF(lFileNum)500     If EndingBorder < ReadPos Then501         FileGetBytesLocal = -1502         Exit Function503     End If504     505     On Error GoTo errH506     If EndingBorder - ReadPos + 1 >= ReadMax Then lngUBound = ReadMax Else _507       lngUBound = EndingBorder - ReadPos + 1508     509     ReDim ArrBytes(1 To lngUBound) As Byte510     511     Get #FileNum, ReadPos, ArrBytes512 513     FileGetBytesLocal = lngUBound514     Exit Function515 errH:516      FileGetBytesLocal = -1517 End Function518 519 520 521 Private Sub Class_Initialize()522     lAutoOpen = True ‘设置 FileName 属性时自动打开文件523     lAutoClose = True ‘读取行读完文件或出错时 自动关闭文件524 End Sub525 526 Private Sub Class_Terminate()527     CloseFile528     Erase af_Buff.bufBytes529 530 End Sub531 532 533 Public Property Get FileName() As String534     FileName = lFileName535 End Property536 537 Public Property Let FileName(ByVal vNewValue As String)538     If lFileNum > 0 Then CloseFile539     lFileName = vNewValue540     If lAutoOpen Then OpenFile541 End Property542 543 Public Property Get FileNum() As Integer544     FileNum = lFileNum545 End Property546 547 Public Property Get Status() As Integer548     Status = lStatus549 End Property550 551 Public Property Get IsEndRead() As Boolean552     IsEndRead = lIsEndRead553 End Property554 555 Public Property Get AutoOpen() As Boolean556     AutoOpen = lAutoOpen557 End Property558 559 Public Property Let AutoOpen(ByVal vNewValue As Boolean)560     lAutoOpen = vNewValue561 End Property562 563 Public Property Get AutoClose() As Boolean564     AutoClose = lAutoClose565 End Property566 567 Public Property Let AutoClose(ByVal vNewValue As Boolean)568     lAutoClose = vNewValue569 End Property570 571 572 Public Property Get ErrOccured() As Boolean573     ErrOccured = lErrOccured574 End Property575 576 Public Property Let ErrOccured(ByVal vNewValue As Boolean)577     lErrOccured = vNewValue578 End Property579 580 Public Property Get Encode() As EncodeEnum581     Encode = lEncode582 End Property583 584 Public Property Let Encode(ByVal vNewValue As EncodeEnum)585     lEncode = vNewValue586 End Property587 588 Public Property Get IsEncodeErr() As Boolean589     IsEncodeErr = EncodeErr590 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 ‘表示尚未发生错误；如后续程序中发生了错误再改为 True106     ‘判断和设置状态107     If lStatus = 0 Then108         ‘lStatus = 0：当前状态非法，尚未打开文件，无法读取109         GoTo errExit110     ElseIf lStatus < 0 Then111         ‘lStatus<0：表示此时文件尚未被打开，或者被强制关闭，或者已经读完文件 _112           ‘被自动关闭，总之是不能再继续读取文件了113         ‘若文件已读取完毕，允许再额外地调用一次GetNextLine方法114         If af_OneEndRead Then ‘允许额外调用一次115             af_OneEndRead = False ‘设置标志为 False，不允许再额外调用116             GetNextLine = 0 ‘不出错，但返回0117             Exit Function ‘此时 lErrOccured 仍为 False118         End If119         GoTo errExit ‘不允许额外调用了，出错120     End If121     122     ‘正常读取的情况：此时 lStatus 要么为1要么为2，即要么文件已经打开， _123       ‘要么已经进入读取状态了，总之读取下一行是没有问题的124     lStatus = 2 ‘设置为2表示已经进入读取状态125     126     127     ‘//////////////// 读取文件，以找到“一行”的内容 ////////////////128     On Error GoTo errExit  ‘有任何错误发生时都转到errExit标签处执行129     130     With af_Buff131         ‘缓冲区逐渐沿文件前进，直到缓冲区起始位置超过文件总长读完文件132         Do Until .StartPosAbso > af_lngFileLength133         134             ‘============ （1）根据需要读取文件的下一个缓冲区内容 ============135             ‘若 .PtrInBuf=-1 表示要读取下一个缓冲区，否则不读取下一个，仍使用 _136               当前缓冲区和 .PtrInBuf 指针137             If .PtrInBuf < 0 Then138                 ‘----从 .StartPosAbso 开始读取一些字节存入缓冲区 .bufBytes()139                 .BufLen = FileGetBytesLocal(.StartPosAbso, .bufBytes())140                 If .BufLen <= 0 Then GoTo errExit ‘读取出错141                 142                 ‘----初始化缓冲区指针143                 .PtrInBuf = 1144                 ‘看是否需要忽略第一个 vbLf145                 If .IgnoreFirstLf Then146                     If .bufBytes(.PtrInBuf) = 10 Then ‘第1个字节确是 vbLf147                         ‘忽略第一个 vbLf148                         .PtrInBuf = .PtrInBuf + 1149                         lEndLineSignLast = 2573 ‘上次的分行符为 vbCrLf150                     Else151                         ‘第1个字节不是 vbLf，而因为要忽略第1个 vbLf _152                           ‘说明上一行最后是 vbCr，故设置上一行分行符为 vbCr153                         lEndLineSignLast = 13154                     End If ‘If .bufBytes(.PtrInBuf) = 10 Then155                     156                     .IgnoreFirstLf = False ‘恢复标志，不忽略第一个 vbLf157                 End If ‘If .IgnoreFirstLf Then158                 159                 ‘初始化下一行起始位置 ptrNextStrStartInBuf （下一行内容包含该字节）160                 .ptrNextStrStartInBuf = .PtrInBuf161             End If ‘If .PtrInBuf < 0 Then162             163             ‘============ （2）逐个扫描缓冲区中的字节，查找分行符 ============164             ‘扫描缓冲区中的字节，直到找到 vbCr或vbLf 或扫描完缓冲区165             For .PtrInBuf = .PtrInBuf To .BufLen166                 ch = .bufBytes(.PtrInBuf)167                 Select Case State ‘34代表双引号 44代表逗号168                     Case NewFieldStart169                         If ch = 34 Then170                             State = QuotesField171                         ElseIf ch = 44 Then172                             lineArr.Add ""173                             State = FieldSeparator174                         ElseIf ch = 13 Or ch = 10 Then175                             State = NewFieldStart176                             Exit For177                         Else178 179                             strArrlBuff = strArrlBuff + 1180                             If strArrlBuff Mod mcInitBuffSize = 0 Then181                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)182                             End If183                             ‘ReDim Preserve strArr(1 To strArrlBuff)184                             strArr(strArrlBuff) = ch185                             ‘strArr.Add ch186                             State = NonQuotesField187                         End If188                     Case NonQuotesField189                         If ch = 44 Then190                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr191                             Erase strArr192                             ReDim strArr(1 To mcInitBuffSize)193                             strArrlBuff = 0194                             ‘Set strArr = New Collection195                             State = FieldSeparator196                         ElseIf ch = 13 Then197                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr198                             State = RowSeparator199                         Else200                             strArrlBuff = strArrlBuff + 1201                             If strArrlBuff Mod mcInitBuffSize = 0 Then202                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)203                             End If204                             ‘ReDim Preserve strArr(1 To strArrlBuff)205                             strArr(strArrlBuff) = ch206                             ‘strArr.Add ch207                         End If208                     Case QuotesField209                         If ch = 34 Then210                             State = QuoteInQuotesField211                         Else212                             strArrlBuff = strArrlBuff + 1213                             If strArrlBuff Mod mcInitBuffSize = 0 Then214                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)215                             End If216                             ‘ReDim Preserve strArr(1 To strArrlBuff)217                             strArr(strArrlBuff) = ch218                             ‘strArr.Add ch219                         End If220                     Case FieldSeparator221                         If ch = 44 Then222                             lineArr.Add ""223                         ElseIf ch = 34 Then224                             Erase strArr225                             ReDim strArr(1 To mcInitBuffSize)226                             strArrlBuff = 0227                             ‘Set strArr = New Collection228                             State = QuotesField229                         ElseIf ch = 13 Then230                             lineArr.Add ""231                             State = RowSeparator232                         Else233                             strArrlBuff = strArrlBuff + 1234                             If strArrlBuff Mod mcInitBuffSize = 0 Then235                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)236                             End If237                             ‘ReDim Preserve strArr(1 To strArrlBuff)238                             strArr(strArrlBuff) = ch239                             ‘strArr.Add ch240                             State = NonQuotesField241                         End If242                     Case QuoteInQuotesField243                         If ch = 44 Then244                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr245                             Erase strArr246                             ReDim strArr(1 To mcInitBuffSize)247                             strArrlBuff = 0248                             ‘Set strArr = New Collection249                             State = FieldSeparator250                         ElseIf ch = 13 Then251                             lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr252                             State = RowSeparator253                         ElseIf ch = 34 Then254                             strArrlBuff = strArrlBuff + 1255                             If strArrlBuff Mod mcInitBuffSize = 0 Then256                                 ReDim Preserve strArr(1 To strArrlBuff + mcInitBuffSize)257                             End If258                             ‘ReDim Preserve strArr(1 To strArrlBuff)259                             strArr(strArrlBuff) = ch260                             ‘strArr.Add ch261                             State = QuotesField262                         Else263                             State = ErrorS ‘"语法错误： 转义字符 \" 不能完成转义 或 引号字段结尾引号没有紧贴字段分隔符";264                         End If265                     Case RowSeparator266                         If ch = 10 Then267                             Erase strArr268                             ReDim strArr(1 To mcInitBuffSize)269                             strArrlBuff = 0270                             ‘Set strArr = New Collection271                             State = NewFieldStart272                             Exit For273                         Else274                             State = ErrorS ‘"语法错误： 行分隔用了回车 \\r。但未使用回车换行 \\r\\n ";275                         End If276                     Case ErrorS277                         GoTo errExit278                                             279                 End Select280 281 ‘                If .bufBytes(.PtrInBuf) = 13 Or _282 ‘                 .bufBytes(.PtrInBuf) = 10 Then Exit For283             Next .PtrInBuf284             285             ‘退出 For 后，判断是否找到了分行符 vbCr或vbLf286             If .PtrInBuf <= .BufLen Then  ‘是否找到了 vbCr或vbLf287             288                 ‘============ （3）找到一个分行符 vbCr或vbLf ============289                 ‘本行读到位置：af_Buff.PtrInBuf - 1290                 291                 ‘---- 设置本行换行符 ----292                 lEndLineSign = .bufBytes(.PtrInBuf)293                 294                 ‘---- 生成要返回的本行字符串到：af_strBuf ----295                 If .PtrInBuf - .ptrNextStrStartInBuf + af_LastBuff.LeftBLen < 1 Then296                     ‘.PtrInBuf = .ptrNextStrStartInBuf 时，例如 .PtrInBuf297                       ‘= .ptrNextStrStartInBuf=1 时，即开始就是 vbCr/vbLf298                     af_strBuf = ""299                 Else300                     ‘-- 将要返回的字符串的所有字节：包括上次剩余的 和 本次到 _301                       ‘.PtrInBuff 的(不算 .PtrInBuff 位置的)全部存入 af_bytsBuf() 数组 --302                     ReDim af_bytsBuf(1 To .PtrInBuf - .ptrNextStrStartInBuf + af_LastBuff.LeftBLen)303                     304                     ‘先保存上次剩余的字节 LeftBytes，存到 af_bytsBuf 的开始305                     With af_LastBuff306                         For j = 1 To .LeftBLen307                             af_bytsBuf(j) = .LeftBytes(j)308                         Next j309                     End With310                     311                     ‘再加上本次范围：[.ptrNextStrStartInBuf,.PtrInBuf) 的字节， _312                       ‘不包含 .PtrInBuf，因为 .PtrInBuf 是 vbCr/vbLf313                     For j = 1 To .PtrInBuf - .ptrNextStrStartInBuf314                         af_bytsBuf(j + af_LastBuff.LeftBLen) = _315                           .bufBytes(.ptrNextStrStartInBuf + j - 1)316                     Next j317 318                     ‘-- 将 af_bytsBuf 中的字节转换为字符串到： af_strBuf --319                     ‘af_strBuf = af_bytsBuf320 321                     af_strBuf = EncodeStr(af_bytsBuf, EncodeErr) ‘代码转换322                     If EncodeErr Then  ‘代码转换出错323                         GoTo errExit324                     End If325                     326                     If lTrimSpaces Then af_strBuf = Trim(af_strBuf)327                     328                     ‘-- 清除上次剩余的字节缓冲区 LeftBytes --329                     Erase af_LastBuff.LeftBytes330                     af_LastBuff.LeftBLen = 0331                 End If332                 333                 ‘---- 判断是否是连续的 vbCr+vbLf，若是，跳过下一个 vbLf ----334                 If .bufBytes(.PtrInBuf) = 13 Then335                     If .PtrInBuf + 1 > .BufLen Then336                         ‘如果下一个字节已经超过这个缓冲区，则无法判断下一个字节 _337                           ‘是否是 vbLf，这里只设置标志，以后判断是否 vbLf 并决定跳过338                         .IgnoreFirstLf = True339                         lEndLineSign = -1340                     Else341                         ‘下一个字节没超过这个缓冲区，下一个字节若是 vbLf 则直接跳过342                         If .bufBytes(.PtrInBuf + 1) = 10 Then343                             .PtrInBuf = .PtrInBuf + 1344                             lEndLineSign = 2573345                         End If346                     End If347                 End If348                 349                 ‘---- 设置当前缓冲区内部的下一行的起始位置 ----350                 ‘注：这里还未使 .PtrInBuf + 1351                 .ptrNextStrStartInBuf = .PtrInBuf + 1 ‘下一行字符包括这个字节352                 353                 ‘---- 返回：判断是否已经读完文件 ----354                 ‘.PtrInBuf 要 + 1 参与判断，因为本次循环后 .PtrInBuf 要 +1，现在还未 +1355                 ‘是否读完文件的标志存到 lIsEndRead，出 if 后据此决定返回值356                 If .PtrInBuf + 1 > .BufLen And _357                   .StartPosAbso + .BufLen > af_lngFileLength Then358                     ‘已经读完文件359                     lIsEndRead = True360                     If lAutoClose Then CloseFile361                 Else362                     ‘还未读完文件，再判断是否文件只剩一个字节；若只剩一个字节并且 _363                       ‘剩下的正好是 vbLf，并且下次要忽略掉 vbLf，则仍是已经读完文件364                     If .StartPosAbso + .BufLen = af_lngFileLength And .IgnoreFirstLf Then365                         ‘读取文件中的最后一个字节，只测试一下366                         Dim tByt() As Byte, tRet As Integer367                         tRet = FileGetBytesLocal(.StartPosAbso + .BufLen, tByt())368                         If tRet <= 0 Then GoTo errExit ‘出错处理369                         If tByt(1) = 10 Then370                             ‘已经读完文件371                             lEndLineSign = 2573372                             lIsEndRead = True373                             If lAutoClose Then CloseFile374                         End If375                     End If376                 End If377                 .PtrInBuf = .PtrInBuf + 1378                 379                 ‘找到了 vbCr/vbLf 返回这一行到：RetString，并退出函数 _380                 ‘但在退出前判断忽略空行，如果是空行就不退出而继续 Loop381                 If lIsEndRead Then382                     ‘已经读完文件，一定 Exit Function383                     RetString = af_strBuf384                     Set col = lineArr385                     Set lineArr = New Collection386                     strArrlBuff = 0387                     If lIgnoreEmpty And Len(af_strBuf) = 0 Then388                         ‘需要忽略空行，且最后一行为空行返回0，但不属于错误389                         GetNextLine = 0390                     Else391                         ‘不需要忽略空行或最后不是空行，但读完了文件，_392                           ‘不是返回1而是返回-1393                         GetNextLine = -1394                     End If395                     Exit Function ‘已经读完文件，一定 Exit Function396                 Else ‘If lIsEndRead Then397                     ‘没有读完文件(忽略空行不退出，否则退出)398                     If lIgnoreEmpty And Len(af_strBuf) = 0 Then399                         ‘忽略空行，不 Exit Function400                         401                     Else402                         ‘不需要忽略空行或最后不是空行，退出403                         RetString = af_strBuf404                         Set col = lineArr405                         Set lineArr = New Collection406                         strArrlBuff = 0407                         GetNextLine = 1408                         Exit Function409                     End If410                 End If ‘If lIsEndRead Then411                 412             Else ‘If .PtrInBuf <= .BufLen Then ‘是否找到了 vbCr或vbLf413                 ‘============ （4）没有找到分行符“vbCr或vbLf”的处理 ============414                 ‘设置标志，=-1 表示下次要重新读取新的缓冲区， _415                   ‘否则不重新读取，仍使用当前缓冲区和 .PtrInBuf 指针416                 .PtrInBuf = -1417                 418                 ‘==== 看缓冲区中是否还有剩余未处理的字节，若有， _419                   ‘将剩余的存入 af_LastBuff.LeftBytes() ====420                 If .ptrNextStrStartInBuf <= .BufLen Then421                     ReDim Preserve af_LastBuff.LeftBytes(1 To _422                       .BufLen - .ptrNextStrStartInBuf + 1 + af_LastBuff.LeftBLen)423                     For j = 1 To .BufLen - .ptrNextStrStartInBuf + 1424                         af_LastBuff.LeftBytes(j + af_LastBuff.LeftBLen) _425                           = .bufBytes(.ptrNextStrStartInBuf + j - 1)426                     Next j427                     af_LastBuff.LeftBLen = .BufLen - _428                       .ptrNextStrStartInBuf + 1 + af_LastBuff.LeftBLen429                 End If430                 431                 ‘==== 准备继续读下一个缓冲区 ====432                 .StartPosAbso = .StartPosAbso + .BufLen433             End If ‘If .PtrInBuf <= .BufLen Then ‘是否找到了 vbCr或vbLf434         Loop435     End With436     437     438     ‘//////////// 全部读完文件，看还有无剩余的 ////////////439     If af_LastBuff.LeftBLen > 0 Then440         441         Select Case State442             Case NonQuotesField443                  lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr444                  Erase strArr445                  ReDim strArr(1 To mcInitBuffSize)446                  strArrlBuff = 0447                  ‘lineArr.Add strArr448                  ‘Set strArr = New Collection449             Case QuotesField450                  GoTo errExit ‘"语法错误： 引号字段未闭合";451             Case FieldSeparator452                 lineArr.Add ""453             Case QuoteInQuotesField454                 lineArr.Add EncodeStr(strArr, EncodeErr, strArrlBuff) ‘代码转换 strArr455                 456         End Select457         458         ‘af_strBuf = af_LastBuff.LeftBytes459         af_strBuf = EncodeStr(af_LastBuff.LeftBytes, EncodeErr)  ‘代码转换460         If EncodeErr Then ‘代码转换出错461             GoTo errExit462         End If463         464         ‘af_strBuf = StrConv(af_strBuf, vbUnicode)465         If lTrimSpaces Then af_strBuf = Trim(af_strBuf)466         RetString = af_strBuf467         Set col = lineArr468         Set lineArr = New Collection469         strArrlBuff = 0470         471         Erase af_LastBuff.LeftBytes472         af_LastBuff.LeftBLen = 0473         If lIgnoreEmpty And Len(af_strBuf) = 0 Then474             GetNextLine = 0475         Else476             GetNextLine = -1477         End If478         479         If lAutoClose Then CloseFile480         lEndLineSign = -2481         lIsEndRead = True482         ‘此时读完文件，必须返回483         Exit Function484     End If485     486 487 errExit:488     lErrOccured = True489     lEndLineSign = 0490     GetNextLine = 0491     ‘为一般错误，不设置 lIsEndRead = True492     If lAutoClose Then CloseFile493 End Function494 495 Private Function EncodeStr(ByRef bytIn() As Byte, hasError As Boolean, Optional byteSize As Long = -1) As String496 497     Select Case Encode498         Case Default499             Dim tempStr As String500             tempStr = bytIn501             EncodeStr = StrConv(tempStr, vbUnicode)502 503         Case ShifJis504             EncodeStr = WCMB_Decode(ShifJis, bytIn, hasError, byteSize)505         Case JIS506              EncodeStr = WCMB_Decode(JIS, bytIn, hasError, byteSize)507         Case Utf8508             EncodeStr = WCMB_Decode(Utf8, bytIn, hasError, byteSize)509         Case GB2312510              EncodeStr = WCMB_Decode(GB2312, bytIn, hasError, byteSize)511     End Select512 513 End Function514 515 516 ‘ 関数名    : WCMB_Decode517 ‘ 返り値    : 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 String523     On Error GoTo ErrHandler524 525     Dim lngInSize As Long526     Dim strBuf As String527     Dim lngBufLen As Long528     Dim lngRtn As Long529     If byteSize > 0 Then530         lngInSize = byteSize531     Else532         If bytIn(UBound(bytIn)) = 13 Then533             lngInSize = UBound(bytIn) - 1534         Else535             lngInSize = UBound(bytIn)536         End If537     End If538     lngBufLen = (lngInSize + 1) * 5539     strBuf = String$(lngBufLen, vbNullChar)540     lngRtn = MultiByteToWideChar _541         (cp, 0, bytIn(1), lngInSize, StrPtr(strBuf), lngBufLen)542     If lngRtn Then543         WCMB_Decode = Left$(strBuf, lngRtn)544     End If545     hasError = False546     Exit Function547 ErrHandler:548     WCMB_Decode = ""549     hasError = True550 End Function551 552 Public Sub Init()553 554     ReDim strArr(1 To mcInitBuffSize) ‘CSV 各个单元 缓冲区555     strArrlBuff = 0556                  557     Erase af_Buff.bufBytes ‘缓冲区558     559     Erase af_LastBuff.LeftBytes560     af_LastBuff.LeftBLen = 0561     562     af_strBuf = ""563     af_lngFileLength = 0564     af_Buff.StartPosAbso = 1 ‘当前缓冲区的起始处所在的文件位置565     af_Buff.ptrNextStrStartInBuf = 1566     567     ‘此作为标志，=-1表示下次运行 GetNextLine 要重新读取新的缓冲区 _568       ‘否则不重新读取，仍使用当前缓冲区和 .PtrInBuf 指针569     af_Buff.PtrInBuf = -1570     571     af_OneEndRead = True ‘设置标志：关闭后再调用一次 GetNextLine 不出错572     lErrOccured = False573     lEndLineSign = 0574     lEndLineSignLast = 0575     576     af_Buff.IgnoreFirstLf = False ‘初始化标志：当前缓冲区不需要忽略第一个字节（若是vblf）577     578     lIsEndRead = False579 End Sub580 581 Public Function GetPercent(Optional DotNum As Integer = 2) As Single582     ‘DotNum保留几位小数，<0或>7为不保留小数583     Dim sngPerc As Single584     585     If af_lngFileLength > 0 Then586         If af_Buff.PtrInBuf < 0 Then587             sngPerc = (af_Buff.StartPosAbso - 1) / af_lngFileLength588         Else589             sngPerc = (af_Buff.StartPosAbso + af_Buff.PtrInBuf - 2) / af_lngFileLength590         End If591     End If592     593     If DotNum >= 0 Or DotNum <= 7 Then594         Dim Temp As Long595         Temp = 10 ^ DotNum596         sngPerc = Int(Temp * sngPerc + 0.5) / Temp597     End If598     599     GetPercent = sngPerc600 End Function601 602 Public Sub CloseFile()603     If lFileNum > 0 Then Close lFileNum: lFileNum = 0604     lStatus = -1 ‘表示文件已关闭605     ‘不Init，防止读取行后自动关闭文件时状态变量被初始化；在OpenFile时会Init606 End Sub607 608 Public Function OpenFile() As Boolean609     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 = True618     Exit Function619 errH:620     If lFileNum > 0 Then CloseFile621     OpenFile = False622 End Function623 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 Long630                           ‘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       ‘若用户终止或取消或无提示框，则返回<0642     643     Dim lngUBound As Long644     645     If EndingBorder <= 0 Then EndingBorder = LOF(lFileNum)646     If EndingBorder < ReadPos Then647         FileGetBytesLocal = -1648         Exit Function649     End If650     651     On Error GoTo errH652     If EndingBorder - ReadPos + 1 >= ReadMax Then lngUBound = ReadMax Else _653       lngUBound = EndingBorder - ReadPos + 1654     655     ReDim ArrBytes(1 To lngUBound) As Byte656     657     Get #FileNum, ReadPos, ArrBytes658 659     FileGetBytesLocal = lngUBound660     Exit Function661 errH:662      FileGetBytesLocal = -1663 End Function664 665 666 667 Private Sub Class_Initialize()668     lAutoOpen = True ‘设置 FileName 属性时自动打开文件669     lAutoClose = True ‘读取行读完文件或出错时 自动关闭文件670     lTrimSpaces = False ‘不自动Trim()结果行671     lIgnoreEmpty = True ‘是否自动忽略空行（注意：如果是最后一行仍可能返回空行）672 End Sub673 674 Private Sub Class_Terminate()675     CloseFile676     Erase af_Buff.bufBytes677     Erase af_LastBuff.LeftBytes678     Erase af_bytsBuf679 End Sub680 681 682 Public Property Get FileName() As String683     FileName = lFileName684 End Property685 686 Public Property Let FileName(ByVal vNewValue As String)687     If lFileNum > 0 Then CloseFile688     lFileName = vNewValue689     If lAutoOpen Then OpenFile690 End Property691 692 Public Property Get FileNum() As Integer693     FileNum = lFileNum694 End Property695 696 Public Property Get Status() As Integer697     Status = lStatus698 End Property699 700 Public Property Get IsEndRead() As Boolean701     IsEndRead = lIsEndRead702 End Property703 704 705 Public Property Get TrimSpaces() As Boolean706     TrimSpaces = lTrimSpaces707 End Property708 709 Public Property Let TrimSpaces(ByVal vNewValue As Boolean)710     lTrimSpaces = vNewValue711 End Property712 713 Public Property Get AutoOpen() As Boolean714     AutoOpen = lAutoOpen715 End Property716 717 Public Property Let AutoOpen(ByVal vNewValue As Boolean)718     lAutoOpen = vNewValue719 End Property720 721 Public Property Get AutoClose() As Boolean722     AutoClose = lAutoClose723 End Property724 725 Public Property Let AutoClose(ByVal vNewValue As Boolean)726     lAutoClose = vNewValue727 End Property728 729 Public Property Get IgnoreEmpty() As Boolean ‘是否自动忽略空行 ""730     IgnoreEmpty = lIgnoreEmpty731 End Property732 733 Public Property Let IgnoreEmpty(ByVal vNewValue As Boolean)734     lIgnoreEmpty = vNewValue735 End Property736 737 Public Property Get EndLineSign() As Integer738     EndLineSign = lEndLineSign739 End Property740 741 Public Property Get EndLineSignLast() As Integer742     EndLineSignLast = lEndLineSignLast743 End Property744 745 Public Property Get ErrOccured() As Boolean746     ErrOccured = lErrOccured747 End Property748 749 Public Property Let ErrOccured(ByVal vNewValue As Boolean)750     lErrOccured = vNewValue751 End Property752 753 Public Property Get Encode() As EncodeEnum754     Encode = lEncode755 End Property756 757 Public Property Let Encode(ByVal vNewValue As EncodeEnum)758     lEncode = vNewValue759 End Property760 761 Public Property Get IsEncodeErr() As Boolean762     IsEncodeErr = EncodeErr763 End Property