On Thu, 04 Dec 2003 10:46:36 +0000, Baz <ba***********@yahoo.co.uk>
wrote:
BIG Thanks You's to Rudy and Larry. There indeed was a couple of EOF
characters in the file which, when deleted, allowed me to scan the
file in its entirety.
I guess my next question is this:
Rather than having to manually remove the EOF characters, how can I
programatically get around this problem. Presumably I need to use a
function other than EOF when accessing my file.
I had a look at opening in Binary mode, Larry, but this didn't help me
too much. There is precious little about it in the books I have or any
of the online help sites I referenced.
Here is a VB Class that will give you some ideas
HTH
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "cReadFileStream"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
' 2/8/01 JF
' 3/8/01 JF - Block Read Added - watch for Block > File Size
'
Private Type TCMN
FileName As String
FileSize As Long
Delin As String
Buffer As String
BufferLen As Long
BufferPos As Long
BytesDone As Long
EofFlag As Boolean
Channel As Integer
End Type
Private cmn As TCMN
' ---
Private Sub Class_Initialize()
cmn.Delin = vbCrLf
cmn.BufferLen = 100000
End Sub
' ---
Public Function Create(FileName$) As Boolean
cmn.FileName = FileName
Create = False
cmn.Buffer = ""
cmn.Channel = 0
cmn.EofFlag = False
cmn.BufferPos = 1
cmn.BytesDone = 0
' ---
If FileExists(FileName$) = False Then
MsgBox "cReadFileStream: " + FileName$ _
+ "File not Found"
Exit Function
End If
' ---
If FileExists(FileName$) Then
cmn.FileSize = FileLen(cmn.FileName)
cmn.Channel = FreeFile
Open FileName For Binary Access Read As #cmn.Channel
Create = True
End If
End Function
' ---
Public Function ReadDelineatedLine() As String
Dim Q&, L&
If cmn.Channel = 0 Then
MsgBox "cReadFileStream - ReadLine - but file not Open"
cmn.EofFlag = True
Exit Function
End If
' ---
If cmn.EofFlag Then
MsgBox "cReadFileStream - Read Past End of File"
Exit Function
End If
' ---
If InStr(cmn.BufferPos, cmn.Buffer, cmn.Delin) = 0 Then
Call LS_FillBuffer
' --- When File completely Read then append Delin if Needed
If cmn.BytesDone = cmn.FileSize Then
If Right$(cmn.Buffer, Len(cmn.Delin)) <> cmn.Delin Then
cmn.Buffer = cmn.Buffer + cmn.Delin
End If
End If
End If
' ---
Q = InStr(cmn.BufferPos, cmn.Buffer, cmn.Delin)
If Q Then
L = Q - cmn.BufferPos
ReadDelineatedLine = Mid$(cmn.Buffer, cmn.BufferPos, L)
cmn.BufferPos = Q + Len(cmn.Delin)
End If
If Q = 0 Then
MsgBox "cReadFileStream - Read - Unexpected Error" _
+ vbCrLf + "Delineator not Found"
End If
' --- Was this the last Field of the Last Buffer
If cmn.BytesDone >= cmn.FileSize Then
If Q >= Len(cmn.Buffer) - Len(cmn.Delin) Then
cmn.EofFlag = True
End If
End If
End Function
' ---
Public Sub ReadBlock(Block$)
Dim BlockLen&, Q&
If cmn.Channel = 0 Then
MsgBox "cReadFileStream - ReadBlock - but file not Open"
cmn.EofFlag = True
Exit Sub
End If
' ---
If cmn.EofFlag Then
MsgBox "cReadFileStream - Read Past End of File"
Exit Sub
End If
' ---
BlockLen& = Len(Block$)
' --- Do we need to fill the Buffer
If (cmn.BufferPos + BlockLen) > Len(cmn.Buffer) Then
If BlockLen > cmn.BufferLen Then ' increase buffer size
cmn.BufferLen = cmn.BufferPos + BlockLen
End If
Call LS_FillBuffer
End If
' --- If insufficient Data left
Q = Len(cmn.Buffer$) - cmn.BufferPos + 1 ' Bytes Left
If BlockLen > Q Then
Block$ = Space$(Q)
BlockLen = Q
End If
' --- Copy the data
Mid$(Block$, 1, BlockLen) = Mid$(cmn.Buffer$, cmn.BufferPos,
BlockLen)
cmn.BufferPos = cmn.BufferPos + BlockLen
' --- Was this the last Field of the Last Buffer
If cmn.BytesDone >= cmn.FileSize Then
If cmn.BufferPos > Len(cmn.Buffer$) Then
cmn.EofFlag = True
End If
End If
End Sub
' ---
Public Function EofFlag() As Boolean
EofFlag = cmn.EofFlag
End Function
' ---
Public Function Size() As Long
Size = cmn.FileSize
End Function
' ---
Public Sub Free()
If cmn.Channel <> 0 Then
Close #cmn.Channel
cmn.Channel = 0
End If
End Sub
' ---
Private Sub LS_FillBuffer()
Dim Hold$, Q&
' --- First time in cmn.Buffer = ""
Hold$ = Mid$(cmn.Buffer, cmn.BufferPos)
If cmn.BytesDone >= cmn.FileSize Then
Exit Sub
End If
' ---
If Len(cmn.Buffer) < cmn.BufferLen Then
cmn.Buffer = Space$(cmn.BufferLen)
End If
' --- Reduce Buffer Size at End of File
Q = cmn.FileSize - cmn.BytesDone
If Q < Len(cmn.Buffer) Then
cmn.Buffer = Space$(Q)
End If
' --- Read a Chunk
Get #cmn.Channel, cmn.BytesDone + 1, cmn.Buffer
cmn.BytesDone = cmn.BytesDone + Len(cmn.Buffer)
' --- Add leftover chunk if needed
If Len(Hold$) Then
cmn.Buffer = Hold + cmn.Buffer
End If
' ---
cmn.BufferPos = 1
End Sub
Private Sub Class_Terminate()
Me.Free
End Sub
'
' Support Routines
'
Function FileExists(Fle$) As Boolean
Dim Q%
On Error Resume Next
Q = GetAttr(Fle$)
If Err = 0 Then
If (Q And vbDirectory) = 0 Then
FileExists = True
End If
End If
Err.Clear
End Function
