VB6 - Huge (>2GB) File I/O Class

I swear I did a search or two first but I hadn't seen this here.

HugeBinaryFile.cls is a VB6 Class that is based on an old MS KB article for VB4.

It works a bit like using Get#/Put# with Byte arrays, and supports absolute seeks to a byte position using a Currency value from 0 to far beyond the usual 2GB limit. It can also do seeks relative to the current file position accepting a signed Long value, and seek to EOF for appending. Its FileLen property returns the open file's length in bytes as a Currency value.

Currency was used for convenience since huge files need a 64-bit position value. Since Currency values have an implied decimal point the class does scaling so that you can use 1 to mean 1 (1.0000) instead of using 0.0001 to mean byte 1.

If you find this imperfect you can always modify the Class to accept and return a pair of unsigned Long values instead. In the end these can get pretty clumsy to work with though.

I did a certain amount of testing, but I won't claim this code is bug-free.


The Class is provided here bundled in a small demo project. To add it to your own projects simply copy the .cls file into your project folder and Add|File... to make it part of your project.


It would be fairly easy to create another Class that wraps this one for doing text I/O.

Look at the posts below for my HugeTextFile class.

Here's another example. Somebody wrote this for me a few years ago.

Put it in a module.

Code:

---

Option Explicit

Const MOVEFILE_REPLACE_EXISTING = &H1
Const FILE_ATTRIBUTE_TEMPORARY = &H100
Const FILE_BEGIN = 0
Const FILE_SHARE_READ = &H1
Const FILE_SHARE_WRITE = &H2
Const CREATE_NEW = 1
Const OPEN_EXISTING = 3
Const OPEN_ALLWAYS = 4
Const GENERIC_READ = &H80000000
Const GENERIC_WRITE = &H40000000

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function SetEndOfFile Lib "kernel32" (ByVal hFile As Long) As Long

Public File_Num As Long
Public File_Len As Currency

Public Sub API_OpenFile(ByVal FileName As String, ByRef FileNumber As Long, ByRef FileSize As Currency)
Dim FileH As Long
Dim Ret As Long
On Error Resume Next
FileH = CreateFile(FileName, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_ALLWAYS, 0, 0)
If Err.Number > 0 Then
    Err.Clear
    FileNumber = -1
Else
    FileNumber = FileH
    Ret = SetFilePointer(FileH, 0, 0, FILE_BEGIN)
    API_FileSize FileH, FileSize
End If
On Error GoTo 0
End Sub

Public Sub API_FileSize(ByVal FileNumber As Long, ByRef FileSize As Currency)
    Dim FileSizeL As Long
    Dim FileSizeH As Long
    FileSizeH = 0
    FileSizeL = GetFileSize(FileNumber, FileSizeH)
    Long2Size FileSizeL, FileSizeH, FileSize
End Sub

Public Sub API_ReadFile(ByVal FileNumber As Long, ByVal Position As Currency, ByRef BlockSize As Long, ByRef Data() As Byte)
Dim PosL As Long
Dim PosH As Long
Dim SizeRead As Long
Dim Ret As Long
Size2Long Position, PosL, PosH
Ret = SetFilePointer(FileNumber, PosL, PosH, FILE_BEGIN)
Ret = ReadFile(FileNumber, Data(0), BlockSize, SizeRead, 0&)
BlockSize = SizeRead
End Sub

Public Sub API_CloseFile(ByVal FileNumber As Long)
Dim Ret As Long
Ret = CloseHandle(FileNumber)
End Sub

Public Sub API_WriteFile(ByVal FileNumber As Long, ByVal Position As Currency, ByRef BlockSize As Long, ByRef Data() As Byte)
Dim PosL As Long
Dim PosH As Long
Dim SizeWrit As Long
Dim Ret As Long
Size2Long Position - 1, PosL, PosH
Ret = SetFilePointer(FileNumber, PosL, PosH, FILE_BEGIN)
Ret = WriteFile(FileNumber, Data(0), BlockSize, SizeWrit, 0&)
BlockSize = SizeWrit
End Sub

Private Sub Size2Long(ByVal FileSize As Currency, ByRef LongLow As Long, ByRef LongHigh As Long)
'&HFFFFFFFF unsigned = 4294967295
Dim Cutoff As Currency
Cutoff = 2147483647
Cutoff = Cutoff + 2147483647
Cutoff = Cutoff + 1 ' now we hold the value of 4294967295 and not -1
LongHigh = 0
Do Until FileSize < Cutoff
    LongHigh = LongHigh + 1
    FileSize = FileSize - Cutoff
Loop
If FileSize > 2147483647 Then
    LongLow = -CLng(Cutoff - (FileSize - 1))
Else
    LongLow = CLng(FileSize)
End If
End Sub

Private Sub Long2Size(ByVal LongLow As Long, ByVal LongHigh As Long, ByRef FileSize As Currency)
'&HFFFFFFFF unsigned = 4294967295
Dim Cutoff As Currency
Cutoff = 2147483647
Cutoff = Cutoff + 2147483647
Cutoff = Cutoff + 1 ' now we hold the value of 4294967295 and not -1
FileSize = Cutoff * LongHigh
If LongLow < 0 Then
    FileSize = FileSize + (Cutoff + (LongLow + 1))
Else
    FileSize = FileSize + LongLow
End If
End Sub

---

Quote:

---

Originally Posted by Chris001

Here's another example. Somebody wrote this for me a few years ago.

Put it in a module.

Code:

---

Option Explicit

Const MOVEFILE_REPLACE_EXISTING = &H1
Const FILE_ATTRIBUTE_TEMPORARY = &H100
Const FILE_BEGIN = 0
Const FILE_SHARE_READ = &H1
Const FILE_SHARE_WRITE = &H2
Const CREATE_NEW = 1
Const OPEN_EXISTING = 3
Const OPEN_ALLWAYS = 4
Const GENERIC_READ = &H80000000
Const GENERIC_WRITE = &H40000000

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function SetEndOfFile Lib "kernel32" (ByVal hFile As Long) As Long

Public File_Num As Long
Public File_Len As Currency

Public Sub API_OpenFile(ByVal FileName As String, ByRef FileNumber As Long, ByRef FileSize As Currency)
Dim FileH As Long
Dim Ret As Long
On Error Resume Next
FileH = CreateFile(FileName, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_ALLWAYS, 0, 0)
If Err.Number > 0 Then
    Err.Clear
    FileNumber = -1
Else
    FileNumber = FileH
    Ret = SetFilePointer(FileH, 0, 0, FILE_BEGIN)
    API_FileSize FileH, FileSize
End If
On Error GoTo 0
End Sub

Public Sub API_FileSize(ByVal FileNumber As Long, ByRef FileSize As Currency)
    Dim FileSizeL As Long
    Dim FileSizeH As Long
    FileSizeH = 0
    FileSizeL = GetFileSize(FileNumber, FileSizeH)
    Long2Size FileSizeL, FileSizeH, FileSize
End Sub

Public Sub API_ReadFile(ByVal FileNumber As Long, ByVal Position As Currency, ByRef BlockSize As Long, ByRef Data() As Byte)
Dim PosL As Long
Dim PosH As Long
Dim SizeRead As Long
Dim Ret As Long
Size2Long Position, PosL, PosH
Ret = SetFilePointer(FileNumber, PosL, PosH, FILE_BEGIN)
Ret = ReadFile(FileNumber, Data(0), BlockSize, SizeRead, 0&)
BlockSize = SizeRead
End Sub

Public Sub API_CloseFile(ByVal FileNumber As Long)
Dim Ret As Long
Ret = CloseHandle(FileNumber)
End Sub

Public Sub API_WriteFile(ByVal FileNumber As Long, ByVal Position As Currency, ByRef BlockSize As Long, ByRef Data() As Byte)
Dim PosL As Long
Dim PosH As Long
Dim SizeWrit As Long
Dim Ret As Long
Size2Long Position - 1, PosL, PosH
Ret = SetFilePointer(FileNumber, PosL, PosH, FILE_BEGIN)
Ret = WriteFile(FileNumber, Data(0), BlockSize, SizeWrit, 0&)
BlockSize = SizeWrit
End Sub

Private Sub Size2Long(ByVal FileSize As Currency, ByRef LongLow As Long, ByRef LongHigh As Long)
'&HFFFFFFFF unsigned = 4294967295
Dim Cutoff As Currency
Cutoff = 2147483647
Cutoff = Cutoff + 2147483647
Cutoff = Cutoff + 1 ' now we hold the value of 4294967295 and not -1
LongHigh = 0
Do Until FileSize < Cutoff
    LongHigh = LongHigh + 1
    FileSize = FileSize - Cutoff
Loop
If FileSize > 2147483647 Then
    LongLow = -CLng(Cutoff - (FileSize - 1))
Else
    LongLow = CLng(FileSize)
End If
End Sub

Private Sub Long2Size(ByVal LongLow As Long, ByVal LongHigh As Long, ByRef FileSize As Currency)
'&HFFFFFFFF unsigned = 4294967295
Dim Cutoff As Currency
Cutoff = 2147483647
Cutoff = Cutoff + 2147483647
Cutoff = Cutoff + 1 ' now we hold the value of 4294967295 and not -1
FileSize = Cutoff * LongHigh
If LongLow < 0 Then
    FileSize = FileSize + (Cutoff + (LongLow + 1))
Else
    FileSize = FileSize + LongLow
End If
End Sub

---

---

I remember that. ;) I think I did, but I actually got it from another site. I needed it for large files > 2 and 4GB for my Winsock downloader.

Wish I knew this class file existed though.

A couple of queries from a beginner re setfilepointer ...

1. is the pointer 0-based or 1-based for the 1st byte of a file ?
ie by way of example, what value do I give setfilepointer to then read the 2nd byte of a file ... 1 or 2 ?

2. But... In the 2nd set of code above from DigiRev, for a READ it does setfilepointer to (Position) yet for a WRITE it does setfilepointer to (Position - 1) first ... which seems to me to overwrite starting on the top of the previous byte... that isn't how GET/PUT work, is it ?
eg if position 2 were specified, it would do a setfilepointer to position 1 and then start writing on the top of position 1 onward ... is that a bug ?

Cheerio

1) 0-based. First byte = position 0, second byte = position 1

2) It should not be (Position - 1). I used that code for an application where I always had to write to (Position - 1) and to make it easier for myself I added (- 1) to the API_WriteFile sub. You need to remove that.

Thanks, I ended up changing it a bit for my own purposes... should I post it or leave it alone ?

If you think it's useful for other people, then post it :)

OK here it is.

Dear members,

I tried your latest class for huge files, but I can't find
SetFilePointerEx in my kernel32.dll.

I use Windows NT, SP2.:rolleyes:

Can you give me a hint ?

best regards henilein.

Sorry mate, http://msdn.microsoft.com/en-us/libr...42(VS.85).aspx says win2k and greater for the EX extended functions.

A quick note for anyone that might come through here and want to use the code posted above. The API_FileSize method incorrectly reports 0-byte file sizes as being 4294967295 bytes in length. To fix this, modify the last line in the method from

Code:

---

Long2Size FileSizeL, FileSizeH, FileSize

---

to this

Code:

---

If FileSizeL = -1 Then
  FileSize = 0
Else
  Long2Size FileSizeL, FileSizeH, FileSize
End If

---

Cheers.

I also have a HugeTextFile class you can use for processing text files.

It works fine for both "normal" sized files and "huge" ones. It also processes both ANSI and Unicode files (Windows "Unicode" i.e. UTF-16LE), with either CRLF or LF line delimiters.. There are ReadLine, WriteLine, and SkipLines methods, a Rewind, etc. as well as an EOF property, LineCount property reflecting current "progress", and so forth.

Even for moderately-sized files the performance will probably beat the memory-hungry "split-de-split" technique people often clumsily use to read a file in one gulp and create an array of text lines. If the files are bigger you may want to specify larger buffers when you call the OpenFile method.


The demo project HugeTextDemo uses Timers to keep the UI responsive but feel free to use straight-line looping through entire files in your programs. That is an entirely separate matter from the HugeTextFile class itself.

The attachment also contains a secondary project MakeFile you should run first to create "old.txt" that HugeTextFile needs.

Regarding PMs

Thanks, but I can't answer questions about the code the thread hijackers posted above. Feel free to PM them directly since they never established their own threads.

If you have questions about the code code samples I attached here ask in the thread. PMs are sort of clunky for that.

Quote:

---

Originally Posted by dilettante

I swear I did a search or two first but I hadn't seen this here.

HugeBinaryFile.cls is a VB6 Class that is based on an old MS KB article for VB4.

It works a bit like using Get#/Put# with Byte arrays, and supports absolute seeks to a byte position using a Currency value from 0 to far beyond the usual 2GB limit. It can also do seeks relative to the current file position accepting a signed Long value, and seek to EOF for appending. Its FileLen property returns the open file's length in bytes as a Currency value.

Currency was used for convenience since huge files need a 64-bit position value. Since Currency values have an implied decimal point the class does scaling so that you can use 1 to mean 1 (1.0000) instead of using 0.0001 to mean byte 1.

If you find this imperfect you can always modify the Class to accept and return a pair of unsigned Long values instead. In the end these can get pretty clumsy to work with though.

I did a certain amount of testing, but I won't claim this code is bug-free.


The Class is provided here bundled in a small demo project. To add it to your own projects simply copy the .cls file into your project folder and Add|File... to make it part of your project.


It would be fairly easy to create another Class that wraps this one for doing text I/O.

Look at the posts below for my HugeTextFile class.

---

' a small bug in Boundary
'For Unicode support,you should use W-Type API

Code:

---


Private Declare Function CreateFileW Lib "kernel32" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal psString As Any) As Long
Private Declare Function LCMapStringW Lib "kernel32" (ByVal Locale As Long, ByVal dwMapFlags As Long, ByVal lpSrcStr As Long, ByVal cchSrc As Long, ByVal lpDestStr As Long, ByVal cchDest As Long) As Long

Private Declare Function CreateFile Lib "KERNEL32.dll" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByRef lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function LCMapString Lib "KERNEL32.dll" Alias "LCMapStringA" (ByVal Locale As Long, ByVal dwMapFlags As Long, ByVal lpSrcStr As String, ByVal cchSrc As Long, ByVal lpDestStr As String, ByVal cchDest As Long) As Long
Private Declare Function lstrlen Lib "KERNEL32.dll" Alias "lstrlenA" (ByVal lpString As String) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long

Private Const INVALID_HANDLE_VALUE = -1

Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000

Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2

Private Const CREATE_NEW = 1
Private Const CREATE_ALWAYS = 2
Private Const OPEN_EXISTING = 3
Private Const OPEN_ALWAYS = 4
Private Const TRUNCATE_EXISTING = 5

Private Const FILE_ATTRIBUTE_NORMAL = &H80

Private Const FILE_BEGIN = 0
Private Const FILE_CURRENT = 1
Private Const FILE_END = 2

Public Function ReadBytes(ByRef Buffer() As Byte) As Long
 
  RaiseErrorIfClosed
 
  If ReadFile(hFile, _
      Buffer(LBound(Buffer)), _
      UBound(Buffer) - LBound(Buffer) + 1, _
      ReadBytes, _
      0) Then

      If ReadBytes = 0 Then
        fEOF = True
      ElseIf ReadBytes < UBound(Buffer) - LBound(Buffer) + 1 Then
        ReDim Preserve Buffer(ReadBytes - 1)
      End If
  Else
      RaiseError HBF_READ_FAILURE
  End If
End Function

---

Since this Class does not deal with text at all, there is no need for the W entrypoints.

However if you want to use Unicode file names then you have a valid point, and CreateFile needs to be CreateFileW with a few other minor changes to its signature and call.

I have no idea why you are using LCMapString though, except perhaps as a fancy version of StrConv?


The nice thing about having the source is that you can hack away and make any customization you want though. If there really is a bug perhaps you can explain it in more detail?

Quote:

---

Originally Posted by dilettante

Since this Class does not deal with text at all, there is no need for the W entrypoints.

However if you want to use Unicode file names then you have a valid point, and CreateFile needs to be CreateFileW with a few other minor changes to its signature and call.

---

Use CreateFileW in your OpenFile function.

Quote:

---

I have no idea why you are using LCMapString though, except perhaps as a fancy version of StrConv?

---

I just copy all APIs from my another project which deal with Unicode text file. LCMAPStringW for GB2GBK conversion.

Code:

---

Public Function GB2GBK(ByVal CSstring As String) As String

  Dim lLen As Long
  Dim CTString As String

    On Error GoTo ToExit

    If CSstring = vbNullString Then Exit Function
    If m_bisNT Then
        lLen = lstrlenW(StrPtr(CSstring))
        CTString = Space$(lLen)
        LCMapStringW &H804, &H4000000, StrPtr(CSstring), lLen, StrPtr(CTString), lLen * 2
        GB2GBK = CTString
      Else
        lLen = lstrlen(CSstring)
        CTString = Space$(lLen)
        LCMapString &H804, &H4000000, CSstring, lLen, CTString, lLen
        GB2GBK = CTString
    End If

Exit Function

ToExit:
    GB2GBK = vbNullString

End Function

---

Quote:

---

The nice thing about having the source is that you can hack away and make any customization you want though. If there really is a bug perhaps you can explain it in more detail?

---

Public Function ReadBytes(ByRef Buffer() As Byte) As Long

RaiseErrorIfClosed

If ReadFile(hFile, _
Buffer(LBound(Buffer)), _
UBound(Buffer) - LBound(Buffer) + 1, _
ReadBytes, _
0) Then

If ReadBytes = 0 Then
fEOF = True
ElseIf ReadBytes < UBound(Buffer) - LBound(Buffer) + 1 Then
ReDim Preserve Buffer(ReadBytes - 1)
End If
Else
RaiseError HBF_READ_FAILURE
End If
End Function

I guess I see what you are getting at.

Instead of relying on the return value to know how many bytes were read you want to truncate the user's buffer (byte array). I had chosen not to do that intentionally. For example the buffer might not be a dynamic array at all, so your change would crash the program. It also adds a bit of extra cost to the read operation.

There is a reason why this is a function returning the length read.

Even if you did want to do this, you should preserve the user's buffer LBound when redimensioning it. One more reason to just let the caller do this costly extra step if it is desired.

Quote:

---

Originally Posted by DigiRev

I remember that. ;) I think I did, but I actually got it from another site. I needed it for large files > 2 and 4GB for my Winsock downloader.

---

Lol .. It's quite strange to see this thread... Considering that I'm the Original Author of the posted Code.. (API_OpenFile, API_FileSize, API_ReadFile, API_WriteFile).. My original article 'Getting Past the 2 Gb File Limit' giving full details about how the modules works and why it's needed was done in Jan of 2007 (Long before this thread started).

But it's so nice to see my work has gotten around, and i figured i'd just let everyone know the original source... :)

:afrog:

Quote:

---

Originally Posted by SAGremlin

Lol .. It's quite strange to see this thread... Considering that I'm the Original Author of the posted Code.. (API_OpenFile, API_FileSize, API_ReadFile, API_WriteFile).. My original article 'Getting Past the 2 Gb File Limit' giving full details about how the modules works and why it's needed was done in Jan of 2007 (Long before this thread started).

But it's so nice to see my work has gotten around, and i figured i'd just let everyone know the original source... :)

---

You must be talking about the thread hijackers, because my code was 100% original work. As much as anything so simple can be original anyway. Earlier versions of the code this thread is about date back a lot further than 2007.

Quote:

---

Originally Posted by dilettante

You must be talking about the thread hijackers, because my code was 100% original work. As much as anything so simple can be original anyway. Earlier versions of the code this thread is about date back a lot further than 2007.

---

No .. not your Class.. If you noted my quote... The code posted by Chris001 and referenced by DigiRev was taken directly from the article that I wrote (which is long before this thread started...)

Also DigiRev say's 'but I actually got it from another site', so i figured i'll simply put up a link to the original source of his.. (also considering, Codeguru is a sister site to VBForums, he could have found the original source very easily...)

Well that's true enough, what he posted does look like plagiarism.

Hi, I just tried the first solution because i need to read random a huge file, but when I arrive beside the 2147483647 bytes I've got an overflow calling the readfile api: it's because the readfile param are declared as long.
Here my code : someone can help me?

Many thanks in advance!

Code:

---


Public Sub ReadFile_2GB(xfilename As String, xlenFile As Double, xlenRec As Double, xStartRecord As Double, xRec As String, xFineFile As Boolean)
' ATTENTION record 1 is with DStartRecord = 0, the second has DStartRecord = 1...
' take care how you call this function!!!

  Dim Temp As Variant
  Dim i As Long
  Dim Ilen As Double
 
  '----xlenRec = record len + CR/FL
 
  If bFirstTime Then
      F.SeekAbsolute 0, 0 'STARTING FROM POSITION 0 OF THE FILE  (Seeks 2 bytes (0*2^32 + 2) = 1 character.
      '----F.SeekRelative -2      ' Seeks forward 1 character (inizio file)
      bFirstTime = False
  Else
      If xlenRec * DStartRecord < xlenFile Then
        'test!!!!
        If xlenRec * DStartRecord <= 2147483647 Then
            F.SeekAbsolute 0, xlenRec * DStartRecord  '  overflow with value = 2.147.483.647! because param is a LONG!!!!)
        Else
            'F.SeekRelative (xlenRec * DStartRecord) ' overflow with value = 2.147.483.647! because param is a LONG!!!!)
            F.SeekAbsolute 1, (xlenRec * DStartRecord) - 2147483647 ' overflow with value = 2.147.483.647! because param is a LONG!!!!)
        End If
      Else
        bEndFile = True
      End If

  End If
 
  Temp = F.ReadBytes(xlenRec)

  Ilen = Len(Temp)
  xRec = ""
 
  'from unicode  to ASCII
  For i = LBound(Temp) To UBound(Temp)
      xRec = xRec & ChrW(Temp(i))
  Next
 
  xStartRecord = xStartRecord + 1
 
End Sub

---

I'm not sure what code you're using. This thread is about the code in attachments to posts #1 and #12. The rest are hitchikers here.

SeekAbsolute from post#1 only takes one argument so your:

Code:

---

F.SeekAbsolute 0, xlenRec * DStartRecord

---

is incorrect since it is trying to pass two values.

The Position argument is Currency, not Long. Your problem is that you have used a Long expression.

However SeekRelative does take a Long argument, because that's all Windows supports for relative seeks.

Yes Dilettante, you are right, I kept another source from somewhere. Thanks , now I will try to transform the buffer in single records

Kind regards

There is an issue that someone may be able to answer. I can open a log file that is being written to by another process with any other means except for this one. Is there a way to open a file in use, using this class?

Are you using the text file I/O class? If so, have you tried opening the file passing HTF_OPEN_EXISTING and HTF_SHARE_READ values?

If you are using the binary I/O class you should be able to accomplish the same thing by dealing with the sharing flags and such when opening the file. The other class should work better for you though since most log files are CRLF-delimited text streams on Windows.

Yes I am using the txt file class and yes crashes the application/vb.

looks similar to this.

Dim strLine as string
Set htfIn = New HugeTextFile
htfIn.OpenFile "C:\Windows\System32\LogFiles\Firewall\pfirewall.log", HTF_ACCESS_READ, HTF_OPEN_EXISTING, HTF_SHARE_READ , BufferSize:=256& * 1024&

With htfIn
Do Until .EOF
strLine = .ReadLine()
Loop
.CloseFile
end with

Yes I am using the txt file class and yes crashes the application/vb.

looks similar to this.

Dim strLine as string
Set htfIn = New HugeTextFile
htfIn.OpenFile "C:\Windows\System32\LogFiles\Firewall\pfirewall.log", HTF_ACCESS_READ, HTF_OPEN_EXISTING, HTF_SHARE_READ , BufferSize:=256& * 1024&

With htfIn
Do Until .EOF
strLine = .ReadLine()
Loop
.CloseFile
end with

What do you mean by "crashes the program" though?

What error number and message do you see? What gets logged in the Application Event Log?

vb6 crashes with Exception code: 0xc0000005 if I compile the application it hangs and never does anything forcing me to kill the application. No error msg/number. It's relatively a small file at this point so it should hang at all unless there is a problem opening the file. Before it would crash vb but would give an error that the file was in use before I changed the HTF_OPEN_EXISTING, HTF_SHARE_READ

edit:

so if I do this..

With htfIn
Do Until .EOF
strLine = .ReadLine()
if .eof then
.CloseFile
end if
Loop
.CloseFile
end with

then i get run time error 45602 error opening file. error 32

The error 45602 reports system error 32 as the reason. The system error 32 is ERROR_SHARING_VIOLATION ("The process cannot access the file because it is being used by another process."). I have no idea how the code you show can get this, since I don't see an open, just two CloseFile() calls.


The other problems most likely come from trying to read a file actively being written, until EOF. Because the process logging to this file is still writing and has not set EOF yet by closing it or calling SetEOF there is no EOF to be detected.

Perhaps it hangs waiting to read a new buffer of data, and then hangs again waiting for another after that, and so on.


Basically, what you are trying to do is impractical. The only way I can imagine making it work at all probably requires the use of GetFileSize()/GetFileSizeEx() to figure out "where to call it quits" instead of relying on an EOF indication from the ReadFile() function. If you really need to do this you could probably rewrite the class to work that way.

Note that you will never get all of the data though, only the part the logging process has flushed to disk. Even then the last "line" of text you retrieve will be an incomplete line most of the time, and you may even get back "garbage" for the part of the file that hasn't been flushed-to yet.

actually something like this works fine


Open strFile For Binary As #intFile
strText = String$(LOF(intFile), 32)
Get #intFile, 1, strText
Close #intFile

strLine() = Split(strText, vbCrLf)
lngLineCount = UBound(strLine)

then I read the lines from the array.. later.. I read the lines starting at the last line I read based on that same array which is stored as a variable. I was just trying to see if I could get a little more speed using this method.

Um...

strText = String$(LOF(intFile), 32)

Is the same thing I mentioned in my previous post.

But hey, since that works for you I'd say just go for it.

You're right.. so I was wondering if you think it would be better to copy the file.. for example to a .bak extension and then read the file.. then I wont risk the chance of not getting the data as it is being written.. I am not sure it would be worth changing. Have you done any speed calculations on this method as to other ways of reading files?

The purpose of the examples I provided isn't speed, but very large file I/O. I don't think they are partcularly faster or slower than most ways of doing file I/O though.

If you have a special case you need help with perhaps starting a question thread will get you some helpful answers.

sorry delete this crap

dilettante, thanks for the awsome code.
I was about to quit my project but thanks to your code I can continue to work on it again.
Is it possible to open two files at the same time? I want to compare thier bytes one by one and decide on it, so I need both of them open at the same time, if not possible then I have to use For ... Next and bunch of huge amount of arrays which slows down the routine for sure.

Just create an instance of the class for each file you need to have open at the same time.

Hello,
Thanks for sharing the Class/Module, But I am having problem on understanding its using.
would you please tell me with an example of using the module with a 2gb file?

Example: Suppose I have a 2Gb file called "hfile.dat". Now how may I read its 1GB bytes and Write them into a New file "hfile_new.dat" ?

Thanks before
Regards,

Pretty basic.

Create two instances of the class. Open one for read and the other for write. Read/write in chunks of 32K or so until you have copied over everything you want. Close both.

Hello,

Ok, but my question is to read bytes from the specific location and same for writing them back to another file.
In the Class, we can read file like:

Code:

---

Set hbfFile = New HugeBinaryFile
hbfFile.OpenFile "test.dat"

---

But how to read bytes from the specific location?
Do i need to use Seek first? Which option is correct of them-

Code:

---

hbfFile.SeekAbsolute
hbfFile.SeekEnd
hbfFile.Relative

---

Thanks
Regards,

If you want to move to the end after opening, call .SeekEnd().

If you want to move to a specific byte position, call .SeekAbsolute() passing the 0-based byte offset from the beginning.

If you want to move ahead or behind by a number of bytes, call .SeekRelative() passing a positive or negative offset from the current position.

Both .ReadBytes() and .WriteBytes() update the file position by the number of bytes read or written.

For more information look in your MSDN Library documentation for the API calls that this class uses. All legitimate versions of VB6 come with the MSDN Library CDs.

Hello dilettante, Thanks

I'v tried but still getting errors. Here's the codes i am using -

Code:

---

Option Explicit
Private hbfFile As HugeBinaryFile

Private Sub Command1_Click()
    Dim BB() As Byte
   
    Set hbfFile = Nothing
    Set hbfFile = New HugeBinaryFile
   
    hbfFile.OpenFile "D:\xp.vmd" '3 GB size
   
    hbfFile.SeekAbsolute 524288000 '500 Mb reading
    ReDim BB(1 To 524288000) '524288000= 500 mb
    hbfFile.ReadBytes BB
    If hbfFile.IsOpen Then hbfFile.CloseFile
End Sub

---

I am getting 2 error messages:

1. run-time error '7':
Out of memory

2. After terminating Project and re-execute:
Error opening file
The process cannot acces the file because it is being used by another process.

Where I'm doing wrong? Please suggest me anyone here..

Thanks

Your first error is because there is a limit on how big the Byte array can be.

I suggest you make it no larger than 512KB, and then after you Seek to the starting point do a series of 512KB reads and writes until you have copied almost everything. Finally Redim the array to fit any smaler leftover chunk at the end and read/write once more.

Something like 256KB might even be better.

The second problem occurs because the program aborts without closing the file (or files). This leaves a file handle open and it stays open until either the compiled EXE terminates or in the IDE the IDE must terminate. You might also use error trapping to catch any failure and then go to a "check for open, if open close the file" handler.

At this point I think you probably need to start a separate question thread in the VB6 questions forum. You are having simple problems understanding how to write VB6 programs.

Hello again,
Ok that's enough for me on this topic, Problem solved after reducing the chunk size.

Thanks & Regards :)

Hello dilettante,
I am trying to use your code in one of my projects. I have a few large files (greater than 2.5GB) and using your class I was able to scan and copy lines from the file. I just used your sample project and slightly modified it. This works absolutely fine except one problem. How can I start reading lines from a specific line position? I have 500,000 lines in my text file and I am only interested in the lines between 290,000 and 340,000.
This code starts from line number 1 and takes almost 15 minutes to reach the lines that I require.... How can I force it to start reading lines at a specific position?

Code:

---

'Inside a loop or timer
    With htfIn
            Line = .ReadLine()
            txtLog.SelText = Line
            txtLog.SelText = vbNewLine
            currentlineNumber = currentlineNumber + 1
            labelReadProgress.Caption = "Reading: " & Format$(currentlineNumber, "#,##0")
            'htfOut.WriteLine Line
            DoEvents
    End With

---

Well, if you knew the starting position of the "line" (remembering that a "line" is an artificial abstraction, the file is a stream of bytes) you can seek to it and read from there.

Without knowing that though (and there is no reason you would) you have little choice but to read forward counting lines as you go.

You might use the SkipLines method passing n-1 to get to line n on he next read. That's about the only worthwhile improvement I can imagine though, and it won't be fantastically quicker.

Sorry.

Thanks for the reply....I have done one slight modification and there is significant improvement....
txtLog.SelText = Line
txtLog.SelText = vbNewLine

I commented these lines (I know interaction with GUI should not have been done in the loop in the first place) but still the improvement was astonishing. Now I can loop through the complete file which btw has 470,880 lines and each line is roughly 5600 characters long in less than 1 minute. Without commenting the textbox related code it took almost 35 minutes.

Good point. GUI controls take a lot of processing to update and involve syncing with video hardware to avoid flicker. Making them invisible while updating them helps, but not updating them at all does wonders.

I wanted to thank the original author. I have been looking for a way to rapidly handle I/O on files larger than 2GB while staying enabled and without callbacks for years. This does it and is very fast. Thanks a bunch for this upload!! I wrote a more robust demo program around it and uploaded to PlanetSourceCode site for everyone to test with. It offers variable file size creation (writing) and file copy functions with status as it goes and the ability to stop it mid-function, demonstrating that it is enabled during operation. I tried many things and they all function as advertised. That is rare and the quality is great. Thanks again.

Mike

Quote:

---

Originally Posted by dilettante

I swear I did a search or two first but I hadn't seen this here.

HugeBinaryFile.cls is a VB6 Class that is based on an old MS KB article for VB4.

It works a bit like using Get#/Put# with Byte arrays, and supports absolute seeks to a byte position using a Currency value from 0 to far beyond the usual 2GB limit. It can also do seeks relative to the current file position accepting a signed Long value, and seek to EOF for appending. Its FileLen property returns the open file's length in bytes as a Currency value.

Currency was used for convenience since huge files need a 64-bit position value. Since Currency values have an implied decimal point the class does scaling so that you can use 1 to mean 1 (1.0000) instead of using 0.0001 to mean byte 1.

If you find this imperfect you can always modify the Class to accept and return a pair of unsigned Long values instead. In the end these can get pretty clumsy to work with though.

I did a certain amount of testing, but I won't claim this code is bug-free.


The Class is provided here bundled in a small demo project. To add it to your own projects simply copy the .cls file into your project folder and Add|File... to make it part of your project.


It would be fairly easy to create another Class that wraps this one for doing text I/O.

Look at the posts below for my HugeTextFile class.

---

Glad it is useful, but be sure to give credit to Microsoft. If I could find the old KB article online I'd provide a link.

Code:

---

Private hbfFile As HugeBinaryFile
Private hbfFilew As HugeBinaryFile
Private bytBuf() As Byte
Private bytBufencoded() As Byte

Private lngBlocks As Long
Dim MAX_BLOCKS As Long
Dim lastbytes As Long
Dim needlast As Boolean
Dim factbyte As Currency

Private Sub Command1_Click()

    On Error Resume Next

    factbyte = 1000000 ' = 1mb

    lngBlocks = 0
    lblRead.Caption = ""
    needlast = False
    Set hbfFile = New HugeBinaryFile
    Set hbfFilew = New HugeBinaryFile

    hbfFile.OpenFile "f:\test\1.mp4"
   
    Kill "f:\test\2.mp4"
    hbfFilew.OpenFile "f:\test\2.mp4"
    'hbfFilew.AutoFlush = True
   
    Caption = " Reading " _
      & Format$(hbfFile.FileLen, "##,###,###,###,##0") _
      & " bytes"

    'MAX_BLOCKS = CCur(hbfFile.FileLen \ factbyte)
    MAX_BLOCKS = CCur(Mid$(CStr(hbfFile.FileLen), 1, Len(CStr(hbfFile.FileLen)) - Len(CStr(factbyte)) + 1))
    lastbytes = CCur(hbfFile.FileLen) - CCur((MAX_BLOCKS * factbyte))
             
    Timer1.Enabled = True
End Sub


Private Sub Timer1_Timer()

    If needlast = True Then
        ReDim bytBuf(1 To lastbytes)
    Else
   
        ReDim bytBuf(1 To factbyte)
   
    End If
   
    hbfFile.ReadBytes bytBuf
   
     
    If hbfFile.EOF Then

        Timer1.Enabled = False
        hbfFile.CloseFile
        Set hbfFile = Nothing
        hbfFilew.CloseFile
        Set hbfFilew = Nothing
    Else
       
        hbfFilew.WriteBytes bytBuf
        lngBlocks = lngBlocks + 1
       
        If lngBlocks + 1 > MAX_BLOCKS Then needlast = True
       
        If lngBlocks > MAX_BLOCKS Then
            lblRead.Caption = hbfFile.FileLen
        Else
            lblRead.Caption = CCur(lngBlocks) * CCur(UBound(bytBuf))
        End If

     
     

    End If
 
End Sub

---

i edited this class and i used aes encryption too, and tested over 3 gigabyte so result is :

https://www.vbforums.com/images/ieimages/2022/02/2.gif
refrences used :
HugeBinaryFile.cls + mdAesCtr.bas
https://www.vbforums.com/images/ieimages/2022/02/12.png

---

exe project:
Attachment 184031
download exe and mp4 tested full video:
https://up.maralhost.com/download1504.html

Quote:

---

Originally Posted by Black_Storm

Code:

---

Private hbfFile As HugeBinaryFile
Private hbfFilew As HugeBinaryFile
Private bytBuf() As Byte
Private bytBufencoded() As Byte

Private lngBlocks As Long
Dim MAX_BLOCKS As Long
Dim lastbytes As Long
Dim needlast As Boolean
Dim factbyte As Currency

Private Sub Command1_Click()

    On Error Resume Next

    factbyte = 1000000 ' = 1mb

    lngBlocks = 0
    lblRead.Caption = ""
    needlast = False
    Set hbfFile = New HugeBinaryFile
    Set hbfFilew = New HugeBinaryFile

    hbfFile.OpenFile "f:\test\1.mp4"
   
    Kill "f:\test\2.mp4"
    hbfFilew.OpenFile "f:\test\2.mp4"
    'hbfFilew.AutoFlush = True
   
    Caption = " Reading " _
      & Format$(hbfFile.FileLen, "##,###,###,###,##0") _
      & " bytes"

    'MAX_BLOCKS = CCur(hbfFile.FileLen \ factbyte)
    MAX_BLOCKS = CCur(Mid$(CStr(hbfFile.FileLen), 1, Len(CStr(hbfFile.FileLen)) - Len(CStr(factbyte)) + 1))
    lastbytes = CCur(hbfFile.FileLen) - CCur((MAX_BLOCKS * factbyte))
             
    Timer1.Enabled = True
End Sub


Private Sub Timer1_Timer()

    If needlast = True Then
        ReDim bytBuf(1 To lastbytes)
    Else
   
        ReDim bytBuf(1 To factbyte)
   
    End If
   
    hbfFile.ReadBytes bytBuf
   
     
    If hbfFile.EOF Then

        Timer1.Enabled = False
        hbfFile.CloseFile
        Set hbfFile = Nothing
        hbfFilew.CloseFile
        Set hbfFilew = Nothing
    Else
       
        hbfFilew.WriteBytes bytBuf
        lngBlocks = lngBlocks + 1
       
        If lngBlocks + 1 > MAX_BLOCKS Then needlast = True
       
        If lngBlocks > MAX_BLOCKS Then
            lblRead.Caption = hbfFile.FileLen
        Else
            lblRead.Caption = CCur(lngBlocks) * CCur(UBound(bytBuf))
        End If

     
     

    End If
 
End Sub

---

i edited this class and i used aes encryption too, and tested over 3 gigabyte so result is :

https://www.vbforums.com/images/ieimages/2022/02/2.gif
refrences used :
HugeBinaryFile.cls + mdAesCtr.bas
https://www.vbforums.com/images/ieimages/2022/02/12.png

---

exe project:
Attachment 184031
download exe and mp4 tested full video:
https://up.maralhost.com/download1504.html

---

Care to share the modified class?

Care to share the modified class?

Quote:

---

Originally Posted by Arch_Stanton

Care to share the modified class?

---

Everything Black_Storm has cobbled together concerning encryption can be found in the original thread (including an alternative to HugeBinaryFile class itself) so post there if you need any guidance.

cheers,
</wqw>

Have been having issues with Dilettante's HBF class, though MOSTLY I am able to find workarounds for things...but there is ONE thing that has caused me problems, which I hope someone can help with.

If I open a file and my app crashes (for instance if there's an error in my code) before I am able to .closefile the app is unable to be started again and reopen the same file because it seems there's still a lock in place for the file in the IDE. The only way I can fix this issue is by shutting the IDE down and opening it up again, which gets really annoying when you're trying to bugfix code...is there a way to unlock the file before trying to open it? I can't do a check to see if .IsOpen because it doesn't give me the option to tell it which file I think could be open, and it is specifically the file which is locked and not the IDE (though the IDE has locked the file, assumedly)

I understand if this is more a filesystem/OS/IDE issue than one with the class, just wanted to know if there's an easy way to programmatically fix it

Dilettante references this issue in #44, but I wonder if there has been any new ideas on ways to deal with it there? He also mentions error trapping, but aside from knowing "On Error" exists I have no experience with it, and I wonder if that would interfere with my debugging :-)

I have been having the same problem. When ever the program crashes (in the IDE or not), it leaves the file open. I am using file API, but I don't think that matters. The API requires the handle to the file in order to close it, and if the program crashes, that handle is gone. If the crash itself doesn't shut down the IDE, then I have to shut it down myself. In some cases, I actually have to reboot the system. Consequently, I have taken to working out the details in complex file routines in separate simulation packages, over which I have more control.

I don't have the answer to your problem, but I am willing to work with you on it.

J.A. Coutts

Quote:

---

Originally Posted by couttsj

I have been having the same problem.
When ever the program crashes (in the IDE or not), it leaves the file open.

---

In case dilettantes Class has an "automatic Handle-Cleanup" in Class_Terminate -
then simply compiling his code into an externally referenced AX-Dll would help.

If you want to test the behaviour of such an AX-Dll-FileClass without much fuss -
the RC6 has a cStream and a cCSV-Class, which operate on that "auto-terminate"-principle.
(havent seen a "file is still open"-warning in decades).

Olaf

Quote:

---

Originally Posted by Schmidt

In case dilettantes Class has an "automatic Handle-Cleanup" in Class_Terminate -
then simply compiling his code into an externally referenced AX-Dll would help.

---

Thanks...but I have no idea how to do it...But, smart little me, I worked it out! Here's how I did it, for other people to follow...anyone should be able to follow it, if I did :-)

1) Load the class on its own into VB
2) Rename the project, NOT the class, "HugeBinaryFileDLL" (just so it is easy to recognise in the DLL list)
3) Right click the project and go to properties. Set as ActiveX DLL, no startup object, leave the rest as-is
4) The IMPORTANT bit (it seems)...click the class file and go to "instancing" and set it to something other than private...I chose GlobalMultiUse, I don't know if that is right or not.
5) Compile as DLL, as normal...then reference the DLL in your app that usually uses it and you can remove the class file that usually did the work. I literally just did these and ran the app and it ran fine, just like if the class file was actually still there (as technically it is, just as a DLL).

Confirmed that when my app crashes it I no longer get the error. And also confirmed that without doing #4 I wasn't even able to compile the DLL.

I would post the DLL as that would save tons of time for everyone, but that is frowned upon here...also, you should know exactly what is in the DLL if at all possible, and this way you do!

Ok, I made some changes to Dil's HugeBinaryFile.cls to fix the problem mentioned above. Basically, it's only a problem when we're in the IDE. And, to summarize, the problem is, when you've got one of these big files open and you click the IDE's "Stop" button, the file doesn't get closed and the Class_Terminate event doesn't get raised. So, next time you run in the IDE, you get an "Already Open" error.

If you exit the IDE, it cleans up, but that's a pain. So, I just saved our hFile in the registry. And, on each execution, I check the registry and make sure the file was previously closed. And, if it wasn't, I close it ... problem solved.

The biggest advantage of this is that it allows us to just pull this class into our project (as opposed to any ActiveX DLL) and use it, and not be afraid of the "Stop" button.

Here's my forked version of Dil's class:

Code:

---

Option Explicit
'
' Tweaked by Elroy to fix IDE bug.
'
'HugeBinaryFile
'==============
'
'A class for doing simple binary I/O on very large disk files
'(well over the usual 2GB limit).  It only does I/O using Byte
'arrays, and makes use of Currency values that are scaled to
'whole numbers in places:
'
'  For a file of one byte the FileLen property returns 1.0000 as
'  its value.
'
'Operation is similar in many ways to native VB Get#/Put# I/O, for
'example the EOF property must be checked after a ReadBytes() call.
'You must also Dim/Redim buffers to desired sizes before calling
'ReadBytes() or WriteBytes().
'
'Short (signed Long) relative seeks and long (unsigned Currency)
'absolute seeks from 0 may be done.
'
'AutoFlush may be set True to force buffer flushes on every write.
'The Flush() method may be called explicitly if necessary.
'

Public Enum HBF_Errors
  HBF_UNKNOWN_ERROR = 45600
  HBF_FILE_ALREADY_OPEN
  HBF_OPEN_FAILURE
  HBF_SEEK_FAILURE
  HBF_FILELEN_FAILURE
  HBF_READ_FAILURE
  HBF_WRITE_FAILURE
  HBF_FILE_ALREADY_CLOSED
End Enum

Private Const HBF_SOURCE = "HugeBinaryFile"

Private Const GENERIC_WRITE As Long = &H40000000
Private Const GENERIC_READ As Long = &H80000000
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80&
Private Const CREATE_ALWAYS = 2
Private Const OPEN_ALWAYS = 4
Private Const INVALID_HANDLE_VALUE = -1
Private Const INVALID_SET_FILE_POINTER = -1
Private Const INVALID_FILE_SIZE = -1

Private Const FILE_BEGIN = 0, FILE_CURRENT = 1, FILE_END = 2

Private Type MungeCurr
    Value As Currency
End Type

Private Type Munge2Long
    LowVal As Long
    HighVal As Long
End Type

Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" ( _
    ByVal dwFlags As Long, _
    lpSource As Long, _
    ByVal dwMessageId As Long, _
    ByVal dwLanguageId As Long, _
    ByVal lpBuffer As String, _
    ByVal nSize As Long, _
    Arguments As Any) As Long

Private Declare Function ReadFile Lib "kernel32" ( _
    ByVal hFile As Long, _
    lpBuffer As Any, _
    ByVal nNumberOfBytesToRead As Long, _
    lpNumberOfBytesRead As Long, _
    ByVal lpOverlapped As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" ( _
    ByVal hObject As Long) As Long

Private Declare Function GetFileSize Lib "kernel32" ( _
    ByVal hFile As Long, _
    lpFileSizeHigh As Long) As Long

Private Declare Function WriteFile Lib "kernel32" ( _
    ByVal hFile As Long, _
    lpBuffer As Any, _
    ByVal nNumberOfBytesToWrite As Long, _
    lpNumberOfBytesWritten As Long, _
    ByVal lpOverlapped As Long) As Long

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" ( _
    ByVal lpFileName As String, _
    ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, _
    ByVal lpSecurityAttributes As Long, _
    ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long) As Long

Private Declare Function SetFilePointer Lib "kernel32" ( _
    ByVal hFile As Long, _
    ByVal lDistanceToMove As Long, _
    lpDistanceToMoveHigh As Long, _
    ByVal dwMoveMethod As Long) As Long

Private Declare Function FlushFileBuffers Lib "kernel32" ( _
    ByVal hFile As Long) As Long

Private hFile As Long
Private sFName As String
Private fAutoFlush As Boolean
Private fEOF As Boolean
Private C As MungeCurr
Private L As Munge2Long
Private bIsInIDE As Boolean
'

Public Property Get AutoFlush() As Boolean
    RaiseErrorIfClosed
    AutoFlush = fAutoFlush
End Property

Public Property Let AutoFlush(ByVal NewVal As Boolean)
    RaiseErrorIfClosed
    fAutoFlush = NewVal
End Property

Public Property Get FileHandle() As Long
    RaiseErrorIfClosed
    FileHandle = hFile
End Property

Public Property Get FileLen() As Currency
    RaiseErrorIfClosed
    L.LowVal = GetFileSize(hFile, L.HighVal)
    If L.LowVal = INVALID_FILE_SIZE Then
        If Err.LastDllError Then RaiseError HBF_FILELEN_FAILURE
    End If
    LSet C = L
    FileLen = C.Value * 10000@
End Property

Public Property Get FileName() As String
    RaiseErrorIfClosed
    FileName = sFName
End Property

Public Property Get EOF() As Boolean
    RaiseErrorIfClosed
    EOF = fEOF
End Property

Public Property Get IsOpen() As Boolean
    IsOpen = hFile <> INVALID_HANDLE_VALUE
End Property

Public Sub CloseFile()
    RaiseErrorIfClosed
    CloseHandle hFile
    sFName = ""
    fAutoFlush = False
    fEOF = False
    hFile = INVALID_HANDLE_VALUE
    '
    ' Added by Elroy.
    ' And now we can delete our registry entry because we're closed.
    ' We use error trapping just in case we were tracing through this module when we clicked "Stop".
    ' We use the App.ThreadID in case multiple copies of the program are running.
    If bIsInIDE Then
        On Error Resume Next
            DeleteSetting App.Title, "Settings" & CStr(App.ThreadID), "HugeBinaryFileHandle"
        On Error GoTo 0
    End If
End Sub

Public Sub Flush()
    RaiseErrorIfClosed
    FlushFileBuffers hFile
End Sub

Public Sub OpenFile(ByVal OpenFileName As String)
    If hFile <> INVALID_HANDLE_VALUE Then
        RaiseError HBF_FILE_ALREADY_OPEN
    End If
    hFile = CreateFile(OpenFileName, GENERIC_WRITE Or GENERIC_READ, 0, _
                      0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
    If hFile = INVALID_HANDLE_VALUE Then
        RaiseError HBF_OPEN_FAILURE
    End If
    sFName = OpenFileName
    '
    ' Added by Elroy.
    ' And save our hFile so we can close it if we're in the IDE and clicked "Stop".
    ' We use the App.ThreadID in case multiple copies of the program are running.
    If bIsInIDE Then SaveSetting App.Title, "Settings" & CStr(App.ThreadID), "HugeBinaryFileHandle", hFile
End Sub

Public Function ReadBytes(ByRef Buffer() As Byte) As Long
    RaiseErrorIfClosed
    If ReadFile(hFile, _
                Buffer(LBound(Buffer)), _
                UBound(Buffer) - LBound(Buffer) + 1, _
                ReadBytes, _
                0) Then
        If ReadBytes = 0 Then
            fEOF = True
        End If
    Else
        RaiseError HBF_READ_FAILURE
    End If
End Function

Public Sub SeekAbsolute(ByVal Position As Currency)
    RaiseErrorIfClosed
    C.Value = Position / 10000@
    LSet L = C
    If SetFilePointer(hFile, L.LowVal, L.HighVal, FILE_BEGIN) _
        = INVALID_SET_FILE_POINTER Then
            If Err.LastDllError Then RaiseError HBF_SEEK_FAILURE
    End If
End Sub

Public Sub SeekEnd()
    RaiseErrorIfClosed
    If SetFilePointer(hFile, 0&, ByVal 0&, FILE_END) _
        = INVALID_SET_FILE_POINTER Then
            RaiseError HBF_SEEK_FAILURE
    End If
End Sub

Public Sub SeekRelative(ByVal Offset As Long)
    'Offset is signed.
    RaiseErrorIfClosed
    If SetFilePointer(hFile, Offset, ByVal 0&, FILE_CURRENT) _
        = INVALID_SET_FILE_POINTER Then
            RaiseError HBF_SEEK_FAILURE
    End If
End Sub

Public Function WriteBytes(Buffer() As Byte) As Long
    RaiseErrorIfClosed
    If WriteFile(hFile, _
                Buffer(LBound(Buffer)), _
                UBound(Buffer) - LBound(Buffer) + 1, _
                WriteBytes, _
                0) Then
        If fAutoFlush Then Flush
    Else
        RaiseError HBF_WRITE_FAILURE
    End If
End Function

Private Sub Class_Initialize()
    '
    ' Added by Elroy.
    ' Reworked this so that, when in the IDE, and we restart ...
    ' it still closes the file on the next run.
    ' We use the App.ThreadID in case multiple copies of the program are running.
    '
    Debug.Assert MakeTrue(bIsInIDE)
    '
    If bIsInIDE Then
        hFile = GetSetting(App.Title, "Settings" & CStr(App.ThreadID), "HugeBinaryFileHandle", INVALID_HANDLE_VALUE)
        If hFile <> INVALID_HANDLE_VALUE Then
            CloseHandle hFile
            ' We use error trapping in case we were tracing through this code when we clicked "Stop".
            On Error Resume Next
                DeleteSetting App.Title, "Settings" & CStr(App.ThreadID), "HugeBinaryFileHandle"
            On Error GoTo 0
            hFile = INVALID_HANDLE_VALUE
        End If
    Else
        hFile = INVALID_HANDLE_VALUE
    End If
End Sub

Private Function MakeTrue(ByRef b As Boolean) As Boolean
    MakeTrue = True: b = True
End Function

Private Sub Class_Terminate()
    '
    ' Added by Elroy.
    ' Reworked to delete our registry setting.
    ' We use the App.ThreadID in case multiple copies of the program are running.
    ' Just for clarity, went ahead and set hFile = INVALID_HANDLE_VALUE.
    '
    If hFile <> INVALID_HANDLE_VALUE Then
        CloseHandle hFile
        ' We use error trapping in case we were tracing through this code when we clicked "Stop".
        If bIsInIDE Then
            On Error Resume Next
                DeleteSetting App.Title, "Settings" & CStr(App.ThreadID), "HugeBinaryFileHandle"
            On Error GoTo 0
        End If
        hFile = INVALID_HANDLE_VALUE
    End If
End Sub

Private Sub RaiseError(ByVal ErrorCode As HBF_Errors)
    Dim Win32Err As Long, Win32Text As String

    Win32Err = Err.LastDllError
    If Win32Err Then
        Win32Text = vbNewLine & "Error " & Win32Err & vbNewLine _
                  & DecodeAPIErrors(Win32Err)
    End If
    If IsOpen Then CloseFile
    Select Case ErrorCode
        Case HBF_FILE_ALREADY_OPEN
            Err.Raise HBF_FILE_ALREADY_OPEN, HBF_SOURCE, _
                "File already open."
        Case HBF_OPEN_FAILURE
            Err.Raise HBF_OPEN_FAILURE, HBF_SOURCE, _
                "Error opening file." & Win32Text
        Case HBF_SEEK_FAILURE
            Err.Raise HBF_SEEK_FAILURE, HBF_SOURCE, _
                "Seek Error." & Win32Text
        Case HBF_FILELEN_FAILURE
            Err.Raise HBF_FILELEN_FAILURE, HBF_SOURCE, _
                "GetFileSize Error." & Win32Text
        Case HBF_READ_FAILURE
            Err.Raise HBF_READ_FAILURE, HBF_SOURCE, _
                "Read failure." & Win32Text
        Case HBF_WRITE_FAILURE
            Err.Raise HBF_WRITE_FAILURE, HBF_SOURCE, _
                "Write failure." & Win32Text
        Case HBF_FILE_ALREADY_CLOSED
            Err.Raise HBF_FILE_ALREADY_CLOSED, HBF_SOURCE, _
                "File must be open for this operation."
        Case Else
            Err.Raise HBF_UNKNOWN_ERROR, HBF_SOURCE, _
              "Unknown error." & Win32Text
    End Select
End Sub

Private Sub RaiseErrorIfClosed()
    If hFile = INVALID_HANDLE_VALUE Then RaiseError HBF_FILE_ALREADY_CLOSED
End Sub

Private Function DecodeAPIErrors(ByVal ErrorCode As Long) As String
    Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000&
    Dim strMsg As String, lngMsgLen As Long

    strMsg = Space$(256)
    lngMsgLen = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0&, _
                              ErrorCode, 0&, strMsg, 256&, 0&)
    If lngMsgLen > 0 Then
        DecodeAPIErrors = Left(strMsg, lngMsgLen)
    Else
        DecodeAPIErrors = "Unknown Error."
    End If
End Function

---