home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / LineIndex_512871262002.psc / LineIndex / 01 / cFileLines.cls next >
Encoding:
Visual Basic class definition  |  2002-01-27  |  7.2 KB  |  230 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "cFileLines"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15. Private parrLineBuffer() As Long '*** Line end location array
  16. Private plngBufferLen   As Long '*** Ubound of parrLineBuffer()
  17. Private plngLinesRead   As Long '*** # lines in parrLineBuffer()
  18. Private pblnInitialized As Boolean '***  True if ReadFile succeeded
  19. Private plngFile        As Long '***  Stores the locked file number
  20.  
  21. Public Function ReadFile(strFileName As String) As Long
  22.   Dim lngBlockSize     As Long '***  Length of file read buffer
  23.   Dim lngLOF           As Long '***  Length of file
  24.   Dim lngFilePos       As Long '***  Start Pos of last block read
  25.   Dim lngNoBlocks      As Long '***  lngNoBlocks = lngLOF \ lngBlockSize
  26.   Dim lngExtra         As Long '***  lngLOF Mod lngBlockSize
  27.   Dim lngMain          As Long '***  lngMain = lngNoBlocks * lngBlockSize
  28.   Dim arrBlock()       As Byte '***  file read buffer
  29.   Dim lngChar          As Long '***  search position in file read buffer
  30.   Dim lngBlockLen      As Long '***  lngBlockLen = UBound(arrBlock) + 1&
  31.   Dim lngCurrentState  As Long '***  1 if last byte of arrBlock = vbLF
  32.   Dim arrDelimit(1)    As Byte '***  stores vbNewLine for InstrB use
  33.  
  34.   '***  If called a second time, cleanup
  35.   pblnInitialized = False
  36.   Erase parrLineBuffer
  37.   plngLinesRead = 0&
  38.   plngBufferLen = 0&
  39.   Close plngFile
  40.   plngFile = 0&
  41.  
  42.   '***  put the end of line in the byte array
  43.   arrDelimit(0) = 13
  44.   arrDelimit(1) = 10
  45.  
  46.   '***  initialize the buffer; there maybe just one line
  47.   ReDim parrLineBuffer(plngLinesRead)
  48.  
  49.   '***  amount of memory used for file read, independend of the file size
  50.   lngBlockSize = 2000&
  51.   '***  instr base compatibility: the ' -1& ' in code would slow down the parser
  52.   ReDim arrBlock(1& To lngBlockSize)
  53.  
  54.   plngFile = FreeFile
  55.   '***  use the whole vocabulary :)
  56.   Open strFileName For Binary Access Read Lock Write As #plngFile
  57.   lngLOF = LOF(plngFile)
  58.  
  59.   lngNoBlocks = lngLOF \ lngBlockSize
  60.   lngExtra = lngLOF Mod lngBlockSize
  61.   lngMain = lngNoBlocks * lngBlockSize
  62.  
  63.   lngCurrentState = 0&
  64.  
  65.   '***  do not load the entire file here
  66.   '***  cause that could cause memory issues
  67.   For lngFilePos = 1& To lngMain Step lngBlockSize
  68.     Get #plngFile, lngFilePos, arrBlock()
  69.     '***  sorry but gosub is faster than a function call
  70.     GoSub tagSearch
  71.   Next
  72.  
  73.   '***  read the last bit of the file
  74.   If lngExtra <> 0 Then
  75.     ReDim arrBlock(1& To lngExtra)
  76.     Get #plngFile, lngFilePos, arrBlock()
  77.     '***  sorry but gosub is faster than a function call
  78.     GoSub tagSearch
  79.   End If
  80.  
  81.   '***  store the EOF as a line end if last line has no vbNewLine
  82.   If lngLOF - 1 <> parrLineBuffer(plngLinesRead) Then
  83.     GoSub tagStoreLine
  84.     '***  correct for missing vbNewLine
  85.     parrLineBuffer(plngLinesRead) = parrLineBuffer(plngLinesRead) - 2
  86.   End If
  87.   '***  store the BOF as a line end of 'virtual' line #0
  88.   parrLineBuffer(0) = -1
  89.   '***  remove extra buffer space
  90.   ReDim Preserve parrLineBuffer(0 To plngLinesRead)
  91.  
  92.   ReadFile = plngLinesRead
  93.  
  94.   If lngLOF > 0 Then
  95.     '***  allow reading of lines
  96.     pblnInitialized = True
  97.   End If
  98.  
  99.   Exit Function
  100.  
  101. tagSearch:
  102.   lngChar = 1&
  103.  
  104.   '***  check for broken vbNewline
  105.   If lngCurrentState = 1& Then
  106.     If arrBlock(1&) = arrDelimit(1&) Then
  107.       '***  found a delimiter
  108.       'Debug.Print "found at: " & lngFilePos + lngChar - 1&
  109.       lngChar = 0&
  110.       GoSub tagStoreLine
  111.       lngCurrentState = 0&
  112.       lngChar = 2&
  113.     End If
  114.   End If
  115.  
  116.   lngBlockLen = UBound(arrBlock) + 1&
  117.  
  118.   Do
  119.  
  120.     '***  searching
  121.     lngChar = InStrB(lngChar, arrBlock, arrDelimit, vbBinaryCompare)
  122.  
  123.     If lngChar = 0& Then
  124.       lngChar = lngBlockLen
  125.     Else
  126.       '***  found a delimiter
  127.       'Debug.Print "found at: " & lngFilePos + lngChar - 1&
  128.       GoSub tagStoreLine
  129.       lngChar = lngChar + 1&
  130.     End If
  131.  
  132.   Loop Until lngChar = lngBlockLen
  133.  
  134.   '***  check for broken vbNewline
  135.   If arrBlock(lngBlockLen - 1&) = arrDelimit(0) Then
  136.     '***  delimit was cut
  137.     lngCurrentState = 1&
  138.   End If
  139.   Return
  140.   '***  End tagSearch:
  141.  
  142. tagStoreLine:
  143.   plngLinesRead = plngLinesRead + 1&
  144.   '***  resize the buffer if needed
  145.   If plngBufferLen < plngLinesRead Then
  146.     plngBufferLen = plngBufferLen * 2 + 100
  147.     ReDim Preserve parrLineBuffer(0 To plngBufferLen) As Long
  148.   End If
  149.   '***  store the end of the line loc
  150.   parrLineBuffer(plngLinesRead) = lngFilePos + lngChar - 1&
  151.   Return
  152.   '***  End tagStoreLine:
  153.  
  154. End Function
  155.  
  156. Public Function Lines2String(lngLineNumber As Long, Optional lngNumber As Long = 1) As String
  157.   Dim arrTempLineBuffer() As Byte
  158.   Dim lngUbound        As Long '***  UpperBound of buffer
  159.   Dim lngStart         As Long '***  Start of read
  160.   Dim lngEnd           As Long '***  End of read
  161.   If pblnInitialized Then
  162.     '*** check input
  163.     If (lngLineNumber > 0) And ((lngLineNumber + lngNumber - 1) <= plngLinesRead) Then
  164.  
  165.       lngStart = parrLineBuffer(lngLineNumber - 1&) + 2
  166.       lngEnd = parrLineBuffer(lngLineNumber + lngNumber - 1) + 1
  167.  
  168.       '***  read the lines
  169.       ReDim arrTempLineBuffer(lngEnd - lngStart) As Byte
  170.       Get #plngFile, lngStart, arrTempLineBuffer()
  171.  
  172.       '***  remove the last vbNewLine for 'Line Input #1, strLine' - compatibility
  173.       '***  the class is 20% faster if you remove this
  174.       lngUbound = UBound(arrTempLineBuffer)
  175.       If lngUbound < 2& Then
  176.         '*** just a vbNewLine; return empty string
  177.         Lines2String = vbNullString
  178.       ElseIf (lngLineNumber + lngNumber - 1) = plngLinesRead Then
  179.         '***  return a string
  180.         Lines2String = StrConv(arrTempLineBuffer, vbUnicode)
  181.       Else
  182.         '***  remove vbNewLine
  183.         ReDim Preserve arrTempLineBuffer(lngUbound - 2)
  184.  
  185.         '***  return a string
  186.         Lines2String = StrConv(arrTempLineBuffer, vbUnicode)
  187.  
  188.       End If
  189.     End If
  190.   End If
  191. End Function
  192.  
  193. Public Function Lines2ByteArray(lngLineNumber As Long, Optional lngNumber As Long = 1) As Byte()
  194.   '***  Returns the line(s) without any modification
  195.   Dim lngStart         As Long '***  Start of read
  196.   Dim lngEnd           As Long '***  End of read
  197.   Dim arrTempLineBuffer() As Byte
  198.   
  199.   If pblnInitialized Then
  200.     '*** check input
  201.     If (lngLineNumber > 0) And ((lngLineNumber + lngNumber - 1) <= plngLinesRead) Then
  202.  
  203.       lngStart = parrLineBuffer(lngLineNumber - 1&) + 2
  204.       lngEnd = parrLineBuffer(lngLineNumber + lngNumber - 1) + 1
  205.  
  206.       '***  read the lines
  207.       ReDim arrTempLineBuffer(lngEnd - lngStart) As Byte
  208.       Get #plngFile, lngStart, arrTempLineBuffer()
  209.  
  210.       '***  return a byte array
  211.       Lines2ByteArray = arrTempLineBuffer
  212.       Erase arrTempLineBuffer
  213.  
  214.     End If
  215.   End If
  216. End Function
  217.  
  218. Private Sub Class_Terminate()
  219.   If pblnInitialized Then
  220.     Erase parrLineBuffer
  221.     Close plngFile
  222.   End If
  223. End Sub
  224.  
  225. Public Property Get LengthOfFile() As Long
  226.   If pblnInitialized Then
  227.     LengthOfFile = LOF(plngFile)
  228.   End If
  229. End Property
  230.