Counting Lines in a file [VB]

Is there another way (faster way) to count the number of lines in a file instead of doing it this way:

VB Code:

Open filename for Input As #1
  Do While Not Eof(1)
    Line Input #1, tmp
    c = c + 1
  Loop
close #1
Open filename for Input As #1
  'do stuff
close #1

I presume you mean a text file with lines separated by CR or LF? If so, I asked a similar question (http://www.vbforums.com/showthread.php?t=333717) and got this reply (haven't tried it though):

Quote:

---

Read the whole text file into memory (in Binary) in one shot. Split the file on LF's and take the Ubounds of the resulting array. This will give you the total lines in a file quite quickly.

---

VBAhack

An example of that, and an alternative way to count (not sure which is faster):

VB Code:

Dim iFileNo As Integer
Dim sFile As String
  iFileNo = FreeFile      'Load entire file into string
  Open filename For Binary As #iFileNo
  sFile = Space(LOF(iFileNo))
  Get #iFileNo, , sFile
  Close #iFileNo
 
MsgBox "file loaded"
 
'method 1 (split)
Dim vSplit as Variant
  vSplit = Split(sFile,vbCrLf)
  MsgBox "Number of lines = " & UBound(vSplit)+1
 
'method 2 (replace)
  MsgBox "Number of lines = " & (Len(sFile) - Len(Replace(sFile,vbCrLf,"")) \ 2
 
  Open filename for Input As #1
    'do stuff
  close #1

VB Code:

MsgBox "Number of lines = " & [b]U[/b]Bound(vSplit)+1

;)

Thanks, I've corrected it now. :)

Even quickier would be to open it in binary and reading it to a byte array instead of a string. It is faster to loop through a byte array counting the character codes than to split a string to string array. This technique would also allow easily to do block reading (ie. 2 GB file, read one MB at a time, count the line changes in the block, get the next block and count...).

There are also other methods of reading a file in a quicker manner. I haven't tested them myself though.

Let the games begin.

VB Code:

Function CountLines( _
    ByRef pszFilename As String, _
    ByVal fUnicode As Boolean _
) As Long
 
Dim hFile       As Long
Dim lFilelen    As Long
Dim lpPos       As Long
Dim chBuf()     As Byte
 
Dim lMax        As Long
Dim i           As Long
Dim lStep       As Long
 
Const CHUNKSIZE = 1024
 
    hFile = FreeFile()
    Open pszFilename For Binary Lock Write As #hFile
 
    lFilelen = LOF(hFile)
    ReDim chBuf(CHUNKSIZE)
 
    lStep = -fUnicode + 1
 
    Do While (lpPos < lFilelen)
        If ((lFilelen - CHUNKSIZE) < lpPos) Then _
            ReDim chBuf(lFilelen - lpPos)
 
        Get #hFile, lpPos + 1, chBuf
 
        lMax = UBound(chBuf)
        For i = 0 To lMax Step lStep
            If (chBuf(i) = 13) Then _
                CountLines = CountLines + 1
        Next i
 
        lpPos = lpPos + CHUNKSIZE
    Loop
 
    Close #hFile
 
End Function

I haven't tried optimising it yet, but it's a start :)