VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsTextReader"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Description = "A Plain Text file Reader with string and byte access to each line of text or a range of lines of text and full search (forward only e.g. left to right)."
'---------------------------------------------------------------------------------------
' Module    : clsTextReader
' Author    : dą(daveCarter)
' Date      : 06/07/2015
' Purpose   : To read text from a file and give access to
'             its data line by line, to provide full range
'             search of its data and statistics regarding
'             the number of words, number of lines ...
' ***********************************************
' The approach being taken is to first derive an array of
' longs describing each character position on which a new
' line starts and to then use that information to extract
' portions of the text being read by way of the Mid function
' e.g. specifying start and length parameters.
' The Find methods return character position/s from which
' a line number is derived.  Wholeword search matching is
' handled using the text file's bytes rather than its string
' data which makes for far speedier processing than
' the traditional method e.g. AscW(Mid$(sText, pos, 1))
' ***********************************************
' This class has been developed in response to me
' wanting a set of functions with which to work
' when reading text file data and needing those
' functions to perform quickly... basically, there
' are a lot of ways to achieve the same kind of stuff
' slowly but which are prettier to read.
' ***********************************************

' ==Sub 11
' + CancelFindAll
' - convertToLCase
' - convertToText
' + DeriveFindAllLineNumbers ( <i/o> Long pPositions[] , <i/o> Long pLineNumbers[] , <i/o> Boolean RaiseEvents )
' + DeriveUniqueLineNumbers ( <i/o> Long FoundLineNos[] , <i/o> Long UniqueLineNos[] )
' - getWordCount
' - initialiseResources
' - postFileRead
' + ReadFile ( <i/o> String FileName )
' - readLineB ( <i/o> Long StartPos , <i/o> Long Length , <i/o> Byte Bytes[] )
' - releaseResources

' ==Function 15
' + FileExists::Boolean ( <i> String FileName )
' + FindAll::Variant ( <i/o> String FindWhat , <i/o> Long StartPos , <i/o> Boolean CaseSensitive , <i/o> Boolean WholeWordOnly , <i/o> Boolean RaiseEvents )
' + Find::Long ( <i/o> String FindWhat , <i/o> Long StartPos , <i/o> Boolean CaseSensitive , <i/o> Boolean WholeWordOnly , <i/o> Boolean RaiseEvents )
' + GetFileName::String
' - isWordBreakChar::Boolean ( <i> Long KeyCode )
' + LineBFromCharPos::Variant ( <i/o> Long CharPos , <i/o> Long LastMin )
' + LineB::Variant ( <i/o> Long LineNumber )
' + LineFromCharPos::String ( <i/o> Long CharPos , <i/o> Long LastMin )
' + LineLength::Long ( <i/o> Long LineNumber )
' + LineNoFromCharPos::Long ( <i/o> Long CharPos , <i/o> Long LastMin )
' + LinesB::Variant ( <i/o> Long FirstLine , <i/o> Long LastLine )
' + LineStartPos::Long ( <i/o> Long LineNumber )
' + Lines::String ( <i/o> Long FirstLine , <i/o> Long LastLine )
' + Line::String ( <i/o> Long LineNumber )
' + WordCount::Long

' ==Property 5
' + FileLength::Long
' + FindEventCountTrigger::Long
' + FindEventCountTrigger:: ( <i/o> Long New_Value )
' + LineCount::Long
' + Text::String

Option Explicit

' ***********************************************
' Event declarations
' ***********************************************
' bunch of find related events

Event FindBegin()
Attribute FindBegin.VB_Description = "Event raised when a Find operation begins execution."
Event FindCancel()
Attribute FindCancel.VB_Description = "Event raised when a Find operation is cancelled."
Event FindProgress(FindCount As Long)
Attribute FindProgress.VB_Description = "Event raised during a Find operation passing the number of found items so far."
Event FindEnd()
Attribute FindEnd.VB_Description = "Event raised when a Find operation has completed."

' ***********************************************
' found event related events

Event DeriveLineNumbers(FindCount As Long, FindPos As Long)
Attribute DeriveLineNumbers.VB_Description = "Translates an array of FindAll char. positions into an array of line numbers."

' ***********************************************
' read events

Event ReadBegin()
Attribute ReadBegin.VB_Description = "Event raised when a read operation begins."
Event ReadEnd()
Attribute ReadEnd.VB_Description = "Event raised when a read operation completes."

' ***********************************************
' text conversion events e.g. in order to use find
'  one must first convert from binary to string data.

Event TextConverted()
Attribute TextConverted.VB_Description = "Event raised when the file's bytes are converted to string (required for Find operations)."
Event TextConvertedToLCase()
Attribute TextConvertedToLCase.VB_Description = "Event raised when the main body of text has been converted to lower case (required for Find operations)."

' ***********************************************
' private variables / properties
Private miFileLength As Long
Private miCharLength As Long

Private msFileName As String
Private msText As String
Private msTextLCase As String

Private mbBytes() As Byte
Private miLineLengths() As Long
Private miLinePositions() As Long

Private miLineCount As Long
Private miWordCount As Long

Private mbHaveTextString As Boolean
Private mbHaveLCaseString As Boolean

Private mbCancelSearch As Boolean

Private sLocalErr As String

Private miMP As MousePointerConstants

Private Const DEF_EVENT_ITERATOR As Long = 64
Private miFindEventCounter As Long

' ***********************************************
' public variables / properties
Public Tag As String
Attribute Tag.VB_VarDescription = "User defined spare data field."

' ***********************************************
' start of source code

' ***********************************************
' ReadFile
' Client interface to initialising this class
'  with a file to read - must be called.
'
' Parameters:
'  FileName::String, the name of the file to read.
' ***********************************************
Sub ReadFile( _
   FileName As String)
Attribute ReadFile.VB_Description = "Main sub for initialising the class with the filename of a text file."
   
   If Not FileExists(FileName) Then _
      GoTo BadFileName:
   
   RaiseEvent ReadBegin
   
   initialiseResources
   
   msFileName = FileName
   
   Dim iFileNum As Integer
   iFileNum = _
      FreeFile()
   
   Open msFileName For Binary As #iFileNum

   miFileLength = LOF(iFileNum)
   
   If miFileLength > 0 Then
      ReDim mbBytes(0 To miFileLength - 1)
      Get #iFileNum, , mbBytes
      
   End If
   
   Close #iFileNum
   
   postFileRead
   
   convertToText
   
   RaiseEvent ReadEnd
   
Exit Sub
BadFileName:

End Sub

' ***********************************************
' FindEventCountTrigger <-Long->
' Sets / Returns the number of Find hits per
' Find Event raising
'
' Parameters:
'  (let) New_Value::Long
' ***********************************************
Property Get FindEventCountTrigger() As Long
Attribute FindEventCountTrigger.VB_Description = "Sets / Returns the number of Find hits before a find event is raised."

   FindEventCountTrigger = miFindEventCounter

End Property

Property Let FindEventCountTrigger( _
   New_Value As Long)
   
   If New_Value > 0 Then _
      miFindEventCounter = New_Value
   
End Property

' ***********************************************
' GetFileName <- String
' Returns the name of the file currently being read
' ***********************************************
Function GetFileName() As String
Attribute GetFileName.VB_Description = "Returns the name of the file containing the main body of text being read."

   GetFileName = msFileName

End Function

' ***********************************************
' Text <- String
' Returns the current file's text content as a string.
'
' Parameters:
'  none
' ***********************************************
Property Get Text() As String
Attribute Text.VB_Description = "Returns the entire body of text as a string."

   If Not mbHaveTextString Then convertToText
   
   Text = msText
   
End Property

' ***********************************************
' FileLength <- Long
' Returns the byte length of the current file
'  being read e.g. Open [file] For Binary; fileLen=LOF(#file)
'
' Parameters:
'  none
' ***********************************************
Property Get FileLength() As Long
Attribute FileLength.VB_Description = "Returns the File Length of the currently loaded file e.g. from LOF function after opening a file in Binary mode."

   FileLength = miFileLength

End Property

' ***********************************************
' LineCount <- Long
' Returns the number of lines counted in the current
'  file being read.
'
' Parameters:
'  none
' ***********************************************
Property Get LineCount() As Long
Attribute LineCount.VB_Description = "Returns the number o lines counted in the main body of text."

   LineCount = miLineCount

End Property

' ***********************************************
' Line <- String
' Returns a line of text from the file being read.
'
' Parameters:
'  LineNumber::Long, the line to read / return as a string.
' ***********************************************
Function Line( _
   LineNumber As Long) As String
Attribute Line.VB_Description = "Returns a single line of data from the main body of text as a string."
   
   Line = LineB(LineNumber)
   
End Function

' ***********************************************
' LineFromCharPos <- String
' Returns a line of text from the file being read
'  by way of specifying a character position,
'  presumed to have been derived from a Find/FindAll op.
'
' Parameters:
'  CharPos::Long, a character position.
'  [LastMin::Long=0], minimum start line number.
' ***********************************************
Function LineFromCharPos( _
   CharPos As Long, _
    Optional LastMin As Long = 0) _
   As String
   
   On Error GoTo ErrHan:
   
   Dim iLine As Long
   ' /* obtain the line number from char pos
   iLine = LineNoFromCharPos(CharPos, LastMin) ' */
   
   ' / return the complete line of text
   LineFromCharPos = Line(iLine) ' */
   
   Exit Function
   
ErrHan:

End Function

' ***********************************************
' Lines <- String
' Returns a range of text across a number of lines
'  having passed first and last line numbers.
'
' Parameters:
'  FirstLine::Long, the first line to start returning
'  LastLine::Long, the last line to return
' ***********************************************
Function Lines( _
   FirstLine As Long, _
    LastLine As Long) _
   As String

   Lines = LinesB(FirstLine, LastLine)

End Function

' ***********************************************
' LineB <- Byte()
' Returns a byte array of the text on line x.
'
' LineNumber::Long, the line number to read from
'  the current file being read
' ***********************************************
Function LineB( _
   LineNumber As Long) _
   As Byte()
Attribute LineB.VB_Description = "Returns a single line of data from the main body of text as a byte array."
      
   Select Case LineNumber
      ' /* filter out of range line number input */
      Case 1 To miLineCount
            
         Dim iFirst As Long, iLen As Long
         ' /* get first line and its length
         iFirst = LineStartPos(LineNumber)
         iLen = LineLength(LineNumber) ' */
         
         ' /* read byte range into function return
         readLineB iFirst, iLen, LineB ' */
         
   End Select
   
End Function

' ***********************************************
' LineBFromCharPos <- Byte()
' see LineFromCharPos - this differs by returning
'  a byte array rather than a string
'
' Parameters:
'  CharPos::Long,
'  LastMin::Long,
' ***********************************************
Function LineBFromCharPos( _
   CharPos As Long, _
    Optional LastMin As Long = 0) _
   As Byte()
   
   On Error GoTo ErrHan:
   
   Dim iLine As Long
   iLine = LineNoFromCharPos(CharPos, LastMin)
   
   LineBFromCharPos = LineB(iLine)
      
   Exit Function
   
ErrHan:

End Function

' ***********************************************
' LinesB <- Byte()
'
'
' Parameters:
'  FirstLine::Long
'  LastLine::Long
' ***********************************************
Function LinesB( _
   FirstLine As Long, _
    LastLine As Long) _
   As Byte()
Attribute LinesB.VB_Description = "Returns a range line of data from the main body of text as a byte array."
   
   Select Case FirstLine
      ' /* filter out invalid first & last lines */
      Case 1 To miLineCount
         
         Select Case LastLine
            ' /* filter out invalid last line */
            Case FirstLine To miLineCount
            
               Dim iFirst As Long, iLast As Long, iLen As Long
               
               ' /* get first line char pos. */
               iFirst = LineStartPos(FirstLine)
               ' /* get last char pos. */
               iLast = LineStartPos(LastLine) + _
                  LineLength(LastLine)
               ' / calc length to extract */
               iLen = iLast - iFirst
               ' / * read byte range into function return */
               readLineB iFirst, iLen, LinesB
               
         End Select
      
   End Select
   
End Function

' ***********************************************
' readLineB
' Reads a line's bytes into param Bytes()
'
' Parameters:
'  StartPos::Long
'  Length::Long
' ***********************************************
Private Sub readLineB( _
   StartPos As Long, _
    Length As Long, _
     Bytes() As Byte)
      
   On Error GoTo errRead:
   
   Bytes = Mid$(msText, StartPos, Length)
' -------------------------------------------------------------------
' NOTE:
'  following code version is real slow...
'  keeping note that I done tried it this way
'
'   ReDim Bytes(0)
'
'   Bytes = StrConv( _
'               MidB(mbBytes, StartPos, Length), _
'           vbUnicode)
' -------------------------------------------------------------------
   
Exit Sub
errRead:

End Sub

' ***********************************************
' LineLength
' Returns the char length of a line
'
' Params:
'  LineNumber::Long,
' ***********************************************
Function LineLength( _
   LineNumber As Long) _
   As Long
Attribute LineLength.VB_Description = "Returns the number of characters in a line of text within the main body of text."
   
   Select Case LineNumber
      ' /* filter out invalid line number */
      Case 1 To miLineCount
         ' /* return line length query answer */
         LineLength = _
            miLineLengths(LineNumber)
         
   End Select
   
End Function

' ***********************************************
' LineStartPos <-Long
'
'
' Parameters:
'  LineNumber::Long
' ***********************************************
Function LineStartPos( _
   LineNumber As Long) _
   As Long
Attribute LineStartPos.VB_Description = "Returns the character position that starts a line identified by its ordinal."
   
   Select Case LineNumber
      ' /* filter out invalid line number */
      Case 1 To miLineCount
         ' return line start pos query answer */
         LineStartPos = _
            miLinePositions(LineNumber)
      
   End Select
   
End Function

' ***********************************************
' LineNoFromCharPos <- Long
'
'
' Parameters:
'  CharPos::Long
'  [LastMin::Long = 0]
' ***********************************************
Function LineNoFromCharPos( _
   CharPos As Long, _
    Optional LastMin As Long = 0) As Long
Attribute LineNoFromCharPos.VB_Description = "Returns a long, a line number, from a character position in the main body of text."
   
   ' Description: return the line number upon which a
   '  character position exists.
   '  We have an array of line start positions and
   '  are using this to quickly identify the line
   '  number on which that char. pos. exists.
   ' Trying a Divide and Conquer approach...
   '  the hope is to vastly reduce the number of tests
   '  required to identify the correct line.
   '  Basically, start by finding a mid point between
   '   start and end, then see in which part the char
   '   pos exists... now start again using the start
   '   and end of the previous calc to find a next
   '   mid point and do over again.  Eventually this
   '   resolves to a single line... the standard
   '   alternative is to simply loop through all
   '   line positions testing along the way, depending
   '   on the number of lines this may or may not be
   '   faster than my divide and conquer attempt.
   '  The main reason to try this out is because I've
   '  got a million lines in my test data and found that
   '  the standard approach could get a bit slow when I
   '  had 10s of thousands of char positions to resolve;
   '   for instance how many times does the character 'e'
   '   appear or how many times does the word 'a' appear?
   '   This class can answer these questions on 28Mb of
   '   plain text really fast however previous attempts
   '   have incurred insufferable waiting to the point of
   '   complete loss of interest in the answer.
   
   ' pseudo pictograph of work reduction in action...
   ' | = start char, --- = no. of chars, | = last char, x = iteration
   ' |---------------------|     1
   ' |----------|                2
   ' |-----|                     3
   ' |---|                       4
   ' |--|                        5
   ' |-|                         6
      
   Dim iMidVal As Long
   Dim iMinLine As Long, iMaxLine As Long, iMidLine As Long
   iMinLine = 1: iMaxLine = miLineCount
   If LastMin > 0 Then iMinLine = LastMin
'''   Dim iAttempts As Long ' not required, just counts iterations
   
TryAgain:

   iMidLine = (iMinLine + iMaxLine) \ 2
   iMidVal = miLinePositions(iMidLine)
   
   Select Case iMidVal
      Case Is > CharPos
         iMaxLine = iMidLine
      Case Is < CharPos
         iMinLine = iMidLine
      Case CharPos
         LineNoFromCharPos = iMidLine
         GoTo Quit:
   End Select
   
   If iMaxLine - iMinLine = 1 Then
      LineNoFromCharPos = iMaxLine - 1
      GoTo Quit:
   End If
      
'''   iAttempts = iAttempts + 1
   GoTo TryAgain:
   
Quit:
'''   Debug.Print LineNoFromCharPos, iAttempts
   
End Function

' ***********************************************
' CancelFind
' Sets module level cancel search flag to true
'  e.g. effectively cancels current search.
'
' Parameters:
'  none
' ***********************************************
Sub CancelFindAll()
Attribute CancelFindAll.VB_Description = "Method used to cancel a Find All operation, requires RaiseEvents parameter to be true."
   mbCancelSearch = True
End Sub

' ***********************************************
' FindAll <- Long()
' Begins a search for a substring within the main
'  file's text data,
' Returns an array of character positions at which
'  the substring was found, array base index is 1!
'
' Parameters:
'  FindWhat::String,
'  [StartPos::Long=0],
'  [CaseSensitive::Boolean=False],
'  [WholeWordOnly::Boolean=False],
'  [RaiseEvents::Boolean::False],
' ***********************************************
Function FindAll( _
   FindWhat As String, _
    Optional StartPos As Long = 0, _
     Optional CaseSensitive As Boolean = False, _
      Optional WholeWordOnly As Boolean = False, _
       Optional RaiseEvents As Boolean = False, _
        Optional LastPos As Long = 0) _
   As Long()
Attribute FindAll.VB_Description = "Returns all positions (after StartPos) of a string within main body of text as an array of Longs."
   '---------------------------------------------------------------------------------------
   ' Purpose   : Return an array of longs matching find char. positions
   '             for the FindWhat string parameter in the file's data.
   '---------------------------------------------------------------------------------------
   If RaiseEvents Then RaiseEvent FindBegin
   
   mbCancelSearch = False
   Dim lRet As Long, iCnt As Long, iPositions() As Long, iFindLen As Long
   iFindLen = Len(FindWhat)
   
   ReDim iPositions(miFileLength \ iFindLen)
   
   Do
   
      lRet = Find(FindWhat, StartPos, _
         CaseSensitive, WholeWordOnly, _
            RaiseEvents, LastPos)
         
      If lRet > 0 Then
         iCnt = iCnt + 1
         iPositions(iCnt) = lRet
         StartPos = lRet + iFindLen
      End If
      
      If Not RaiseEvents Then GoTo SkipEvents:
      
      DoEvents
      If mbCancelSearch Then
         RaiseEvent FindCancel
         GoTo CancelFindAll:
      End If
         
      If iCnt Mod miFindEventCounter = 0 Then
         RaiseEvent FindProgress(iCnt)
      End If
      
SkipEvents:

   Loop While lRet > 0
   
CancelFindAll:
   
   ReDim Preserve iPositions(iCnt)
   FindAll = iPositions
   
   Erase iPositions
   If RaiseEvents Then RaiseEvent FindEnd
   
   DoEvents
   
End Function

' ***********************************************
' Find
'
'
' Parameters: (passing params byRef for speed)
'  FindWhat::String,
'  [StartPos::Long=0],
'  [CaseSensitive::Boolean=False],
'  [WholeWordOnly::Boolean=False],
'  [RaiseEvents::Boolean::False],
' ***********************************************
Function Find( _
   FindWhat As String, _
    Optional StartPos As Long = 0, _
     Optional CaseSensitive As Boolean = False, _
      Optional WholeWordOnly As Boolean = False, _
       Optional RaiseEvents As Boolean = False, _
        Optional LastPos As Long = 0) _
   As Long
Attribute Find.VB_Description = "Returns first position (after StartPos) of a string within main body of text as a Long."
               
   If RaiseEvents Then RaiseEvent FindBegin
   
   If miFileLength = 0 Then GoTo Quit:
   If Len(FindWhat) = 0 Then GoTo Quit:
      
   Dim iFWLen As Long
   iFWLen = Len(FindWhat)
   
   If StartPos < 1 Then StartPos = 1
   
   Dim iStart As Long
   iStart = StartPos
   If iStart > (miFileLength - iFWLen) Then _
      GoTo Quit:
   
   ' first time only ---------------------------------------------------
   If Not mbHaveTextString Then convertToText
   
   If Not CaseSensitive Then _
      If Not mbHaveLCaseString Then convertToLCase
   ' -------------------------------------------------------------------
   
   Dim iLeft As Long, iRight As Long
   
TryAgain:
   
   If CaseSensitive Then
      Find = InStr(iStart, msText, FindWhat)
   Else
      Find = InStr(iStart, msTextLCase, LCase$(FindWhat))
   End If
   
   If Find = 0 Then GoTo Quit:
   
   If LastPos > 0 Then
      If Find > LastPos Then
         Find = 0
         GoTo Quit:
      End If
   End If
   
   If WholeWordOnly Then
   
      iLeft = 0: iRight = 0
      
      ' test bytes either side of search string ---------------------------
      ' The standard approach e.g.
      ' iLeft = AscW(Mid$(msText, Find - 2, 1)) and
      ' iRight = AscW(Mid$(msText, Find + FindLen - 1, 1))
      ' just wasn't fast enough on 28Mb data file.
      
      If Find > 1 Then _
         iLeft = mbBytes(Find - 2)
      
      If miFileLength > Find + iFWLen Then _
         iRight = mbBytes(Find + iFWLen - 1)
      
      If Not isWordBreakChar(iLeft) Or _
            Not isWordBreakChar(iRight) Then
            
         iStart = Find + iFWLen
         
         GoTo TryAgain:
         
      End If
      ' -------------------------------------------------------------------
      
   End If
   
Quit:
   If RaiseEvents Then RaiseEvent FindEnd
   
End Function

' ***********************************************
' DeriveFindAllLineNumbers
'
' Parameters:
'
' ***********************************************
Sub DeriveFindAllLineNumbers( _
   ByRef pPositions() As Long, _
    ByRef pLineNumbers() As Long, _
     Optional RaiseEvents As Boolean = False)
Attribute DeriveFindAllLineNumbers.VB_Description = "Returns an array of longs, line numbers (pLineNumbers) derived from array of character positions (pPositions) that has been returned from a FindAll operation."
      
   ' this tries to derive an array of line numbers from
   ' an array of character positions into pLineNumbers
   
   ' note:
   ' values in pPositions elements are presumed to increase from first to last
   
   ' context
   ' we've just run a find all matches and we want to
   ' extract the lines on which the search string was found
   ' we've grabbed the pPosArray from the find all matches
   ' and bung it here to get the line numbers involved

   Dim lngLUBnd        As Long     ' ubound for internal lines array
   Dim lngPUBnd        As Long     ' ubound for positions array [pPositions]
   Dim lngPLoop        As Long     ' positions loop - outer loop
   Dim iLastLine       As Long
   
   On Error GoTo ErrHan:
   ' test arrays, line nos & char positions ----------------------------
   ' will trhow error if either array is not dimensioned ---------------
   lngLUBnd = UBound(miLinePositions)
   lngPUBnd = UBound(pPositions)
   ' -------------------------------------------------------------------
   ReDim pLineNumbers(lngPUBnd)
   ' loop thru' found char positions -----------------------------------
   For lngPLoop = 0 To lngPUBnd
      ' -------------------------------------------------------------------
      
      iLastLine = _
         LineNoFromCharPos(pPositions(lngPLoop), iLastLine)
         
      pLineNumbers(lngPLoop) = iLastLine
      ' -------------------------------------------------------------------
      
      If Not RaiseEvents Then GoTo SkipEvents:
      
      DoEvents
      If mbCancelSearch Then Exit For
      
      If lngPLoop Mod miFindEventCounter = 0 Then _
         RaiseEvent DeriveLineNumbers(lngPUBnd, lngPLoop + 1)
         
SkipEvents:
   Next lngPLoop
   ' -------------------------------------------------------------------
    
Exit Sub
ErrHan:
   Debug.Assert False
End Sub

' ***********************************************
' DeriveUniqueLineNumbers
'
'
' Parameters:
'
' ***********************************************
Sub DeriveUniqueLineNumbers( _
   ByRef FoundLineNos() As Long, _
      ByRef UniqueLineNos() As Long)
Attribute DeriveUniqueLineNumbers.VB_Description = "Resolves an array of FindAll line numbers to a list of unique line numbers e.g. removes duplicates from an array of longs."
   
   ' Use this to rationalise an array of longs
   ' into an array of unique longs e.g. we have
   ' derived some line numbers from a FindAll
   ' and now we just want a unique list of
   ' line numbers.
   
   ' the caller should use UBound(UniqueLineNos) to
   ' acquire the number of records, 1st rec index = 1
   
   On Error GoTo DeriveUniqueLineNumbers_Error:
   
   Dim iCurrNo As Long, iLastNo As Long, iCount As Long
   Dim iCurr As Long, iMax As Long

   iMax = UBound(FoundLineNos)
   ReDim UniqueLineNos(iMax)
   
   Do While iCurr < iMax
      iCurr = iCurr + 1
      iCurrNo = FoundLineNos(iCurr)
      If Not (iCurrNo = iLastNo) Then
         iCount = iCount + 1
         UniqueLineNos(iCount) = iCurrNo
      End If
      iLastNo = iCurrNo
   Loop

   ReDim Preserve UniqueLineNos(iCount)

Exit Sub
DeriveUniqueLineNumbers_Error:
   sLocalErr = "Error " & Err.Number & " (" & Err.Description & ") in procedure DeriveUniqueLineNumbers of Class Module clsTextReader"
   Debug.Print sLocalErr

End Sub

' ***********************************************
' WordCount <- Long
' ***********************************************
Function WordCount() As Long
Attribute WordCount.VB_Description = "Returns a long, the number of words counted in the main body of text."

   If miWordCount = 0 Then getWordCount
   WordCount = miWordCount

End Function
' -------------------------------------------------------------------

' ***********************************************
' convertToText
' ***********************************************
Private Sub convertToText()
   
   On Error GoTo convertToText_Error:
   
   miMP = Screen.MousePointer
   Screen.MousePointer = vbHourglass

   msText = StrConv(mbBytes, vbUnicode)
   miCharLength = Len(msText)
   
   mbHaveTextString = True
   
   RaiseEvent TextConverted

ResErr:
   Screen.MousePointer = miMP

Exit Sub
convertToText_Error:
   sLocalErr = "Error " & Err.Number & " (" & Err.Description & ") in procedure convertToText of Class Module clsTextReader"
   Debug.Print sLocalErr
   Resume ResErr:
   
End Sub

' ***********************************************
' convertToLCase
' ***********************************************
Private Sub convertToLCase()
   
   On Error GoTo convertToLCase_Error:

   If Not mbHaveTextString Then convertToText
   msTextLCase = StrConv(msText, vbLowerCase)
   
   mbHaveLCaseString = True
   
   RaiseEvent TextConvertedToLCase
   
Exit Sub
convertToLCase_Error:
   sLocalErr = "Error " & Err.Number & " (" & Err.Description & ") in procedure convertToLCase of Class Module clsTextReader"
   Debug.Print sLocalErr
   
End Sub

' ***********************************************
' postFileRead
' ***********************************************
Private Sub postFileRead()

   ' Description: Capture Start Pos and Length of each
   ' line of text in the data.
   
   On Error GoTo postFileRead_Error:

   ReDim miLineLengths(miFileLength)
   ReDim miLinePositions(miFileLength)
      
   Dim iStartPos As Long
   
   Dim iLoop As Long
   For iLoop = LBound(mbBytes) To UBound(mbBytes) - 2
   
      If mbBytes(iLoop) = 13 Then ' vbCr
      
         miLineCount = _
            miLineCount + 1
         ' -------------------------------------------------------------------
         miLinePositions(miLineCount) = _
            iStartPos + 1 ' e.g. byte start = 0, string start = 1
            
         miLineLengths(miLineCount) = _
            iLoop - iStartPos
         ' -------------------------------------------------------------------
         iStartPos = _
            iLoop + 1
            
         If mbBytes(iLoop + 1) = 10 Then ' next char vbLF to make vbCrLf?
            iStartPos = _
               iStartPos + 1
         End If
         
      End If
      
   Next iLoop
   
   miLinePositions(miLineCount) = _
      iStartPos + 1
      
   miLineLengths(miLineCount) = _
      miFileLength - iStartPos
   
   ReDim Preserve miLineLengths(miLineCount)
   ReDim Preserve miLinePositions(miLineCount)
   
Exit Sub
postFileRead_Error:
   sLocalErr = "Error " & Err.Number & " (" & Err.Description & ") in procedure postFileRead of Class Module clsTextReader"
   Debug.Print sLocalErr

End Sub

' ***********************************************
' isWordBreakChar <- Boolean
' ***********************************************
Private Function isWordBreakChar( _
 ByVal KeyCode As Long) As Boolean
   '---------------------------------------------------------------------------------------
   ' Purpose   : Return True/False if a key code is considered
   '             to be a word breaking character (used by FindString).
   '---------------------------------------------------------------------------------------
    
    isWordBreakChar = _
      KeyCode < 48 Or KeyCode > 57 And _
         KeyCode < 65 Or KeyCode > 90 And _
            KeyCode < 96 Or KeyCode > 122 And _
               KeyCode < 127
    
End Function

' -------------------------------------------------------------------
' ***********************************************
' getWordCount
' ***********************************************
Private Sub getWordCount()
   '---------------------------------------------------------------------------------------
   ' Purpose   : calculate the number of words in the text
   '             update miWordCount with result - this should
   '             only be called once for any one file (if at all).
   '---------------------------------------------------------------------------------------

   On Error GoTo getWordCount_Error:
   
   Dim iCurr As Long, iMax As Long, iChar As Long
   Dim iCharCount As Long

   iMax = miFileLength
   Do While iCurr < iMax
      iChar = mbBytes(iCurr)
      If isWordBreakChar(iChar) Then
         If iCharCount > 0 Then
            miWordCount = miWordCount + 1
            iCharCount = 0
         End If
      Else
         iCharCount = iCharCount + 1
      End If
      iCurr = iCurr + 1
   Loop
   If iCharCount > 0 Then miWordCount = miWordCount + 1
   
Exit Sub
getWordCount_Error:
   Debug.Print "Error " & Err.Number & " (" & Err.Description & ") in procedure getWordCount of Class Module cReader"

End Sub

' -------------------------------------------------------------------
' ***********************************************
' initialiseResources
' ***********************************************
Private Sub initialiseResources()
   releaseResources
   ReDim miCharPos(5)
End Sub

' ***********************************************
' releaseResources
' ***********************************************
Private Sub releaseResources()
   
   Erase miLineLengths
   Erase miLinePositions
   Erase mbBytes
   
   msFileName = vbNullString ' ""
   miLineCount = 0
   miWordCount = 0
   miFileLength = 0
   miCharLength = 0
   
   mbHaveTextString = False
   mbHaveLCaseString = False
   
   msText = vbNullString ' ""
   msTextLCase = vbNullString ' ""
   
   miMP = vbDefault
   
End Sub

' -------------------------------------------------------------------
' ***********************************************
' FileExists <- Boolean
' ***********************************************
Function FileExists( _
   ByVal FileName As String) As Boolean
Attribute FileExists.VB_Description = "Standard File Exists function, passed a filename and returns True or False regarding whether the file exists or not."
   '---------------------------------------------------------------------------------------
   ' Purpose   : Test for existence of a file, returns True or False.
   '---------------------------------------------------------------------------------------

   On Error GoTo NotFound:

   Dim iFile As Long
   iFile = _
      GetAttr(FileName) ' if we get past this without
                        ' error then something exists
   
   If iFile And vbDirectory Then _
      GoTo NotFound: ' if it's a folder return false
      
   FileExists = True
   
Exit Function
NotFound:

End Function

Private Sub Class_Initialize()
   miFindEventCounter = DEF_EVENT_ITERATOR
End Sub

Private Sub Class_Terminate()
   releaseResources
End Sub
