How To Seek Past VBA's 2GB File Limit

Summary

When performing low-level random file I/O using the Seek, Get, and Put statements, you are limited to a maximum file size of 2^31 bytes(2 GB). This article provides a sample class for random file I/O that allows access beyond the 2GB limit.

More Information

All file I/O ends up calling low-level Windows APIs, such as ReadFile, WriteFile, and SetFilePointer. The Seek statement calls the SetFilePointer API. This API takes both a low 32-bit value (DWORD) and a pointer to a high DWORD value to indicate a 64-bit position for the next read or write. If the pointer to the high DWORD is NULL (zero), then the API limits the range of values to approximately 2GB.


The class procedure provided in this article provides the following features:


  • It encapsulates basic functionality for opening, closing, reading, writing, and seeking on files using low-level Windows APIs to get around the 2GB file limit.
  • It provides basic error trapping.
  • It currently supports reading and writing byte arrays, but can be easily extended to support other data types.
  • It exports the file handle, so you can call the APIs natively in your own application, especially if you want to pass User Defined Types (UDTs) to the ReadFile or WriteFile APIs.
The class has the following methods:


IsOpen Returns a boolean to indicate whether the file is open.

OpenFile Opens the file specified by the sFileName argument.

CloseFile Closes the currently open file.

ReadBytes Reads ByteCount bytes and returns them in a Variant byte
array and moves the pointer.

WriteBytes Writes the contents of the byte array to the current
position in the file and moves the pointer.

Flush Forces Windows to flush the write cache.

SeekAbsolute Moves the file pointer to the designated position from the
beginning of the file. Though VBA treats the DWORDS as
signed values, the API treats them as unsigned. Make the
high-order argument non-zero to exceed 4GB. The low-order
DWORD will be negative for values between 2GB and 4GB.

SeekRelative Moves the file pointer up to +/- 2GB from the current
location. You can rewrite this method to allow for
offsets greater than 2GB by converting a 64-bit signed
offset into two 32-bit values.
The class has the following properties:

FileHandle The file handle for the currently open file. This is not
compatible with VBA file handles.

FileName The name of the currently open file.

AutoFlush Sets/indicates whether WriteBytes will automatically call
the Flush method.

Create the Sample Class

  1. Create a new VBA project.
  2. Add a Class Module and set the Class Name to "Random".
  3. Add the following code to the Class Module:
          Option Explicit

    Public Enum W32F_Errors
    W32F_UNKNOWN_ERROR = 45600
    W32F_FILE_ALREADY_OPEN
    W32F_PROBLEM_OPENING_FILE
    W32F_FILE_ALREADY_CLOSED
    W32F_Problem_seeking
    End Enum

    Private Const W32F_SOURCE = "Win32File Object"

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

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

    Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000

    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 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, sFName As String, fAutoFlush As Boolean

    Public Property Get FileHandle() As Long
    If hFile = INVALID_HANDLE_VALUE Then
    RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    FileHandle = hFile
    End Property

    Public Property Get FileName() As String
    If hFile = INVALID_HANDLE_VALUE Then
    RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    FileName = sFName
    End Property

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

    Public Property Get AutoFlush() As Boolean
    If hFile = INVALID_HANDLE_VALUE Then
    RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    AutoFlush = fAutoFlush
    End Property

    Public Property Let AutoFlush(ByVal NewVal As Boolean)
    If hFile = INVALID_HANDLE_VALUE Then
    RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    fAutoFlush = NewVal
    End Property

    Public Sub OpenFile(ByVal sFileName As String)
    If hFile <> INVALID_HANDLE_VALUE Then
    RaiseError W32F_FILE_ALREADY_OPEN, sFName
    End If
    hFile = CreateFile(sFileName, GENERIC_WRITE Or GENERIC_READ, 0, _
    0, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
    If hFile = INVALID_HANDLE_VALUE Then
    RaiseError W32F_PROBLEM_OPENING_FILE, sFileName
    End If
    sFName = sFileName
    End Sub

    Public Sub CloseFile()
    If hFile = INVALID_HANDLE_VALUE Then
    RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    CloseHandle hFile
    sFName = ""
    fAutoFlush = False
    hFile = INVALID_HANDLE_VALUE
    End Sub

    Public Function ReadBytes(ByVal ByteCount As Long) As Variant
    Dim BytesRead As Long, Bytes() As Byte
    If hFile = INVALID_HANDLE_VALUE Then
    RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    ReDim Bytes(0 To ByteCount - 1) As Byte
    ReadFile hFile, Bytes(0), ByteCount, BytesRead, 0
    ReadBytes = Bytes
    End Function

    Public Sub WriteBytes(DataBytes() As Byte)
    Dim fSuccess As Long, BytesToWrite As Long, BytesWritten As Long
    If hFile = INVALID_HANDLE_VALUE Then
    RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    BytesToWrite = UBound(DataBytes) - LBound(DataBytes) + 1
    fSuccess = WriteFile(hFile, DataBytes(LBound(DataBytes)), _
    BytesToWrite, BytesWritten, 0)
    If fAutoFlush Then Flush
    End Sub

    Public Sub Flush()
    If hFile = INVALID_HANDLE_VALUE Then
    RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    FlushFileBuffers hFile
    End Sub

    Public Sub SeekAbsolute(ByVal HighPos As Long, ByVal LowPos As Long)
    If hFile = INVALID_HANDLE_VALUE Then
    RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    LowPos = SetFilePointer(hFile, LowPos, HighPos, FILE_BEGIN)
    End Sub

    Public Sub SeekRelative(ByVal Offset As Long)
    Dim TempLow As Long, TempErr As Long
    If hFile = INVALID_HANDLE_VALUE Then
    RaiseError W32F_FILE_ALREADY_CLOSED
    End If
    TempLow = SetFilePointer(hFile, Offset, ByVal 0&, FILE_CURRENT)
    If TempLow = -1 Then
    TempErr = Err.LastDllError
    If TempErr Then
    RaiseError W32F_Problem_seeking, "Error " & TempErr & "." & _
    vbCrLf & CStr(TempErr)
    End If
    End If
    End Sub

    Private Sub Class_Initialize()
    hFile = INVALID_HANDLE_VALUE
    End Sub

    Private Sub Class_Terminate()
    If hFile <> INVALID_HANDLE_VALUE Then CloseHandle hFile
    End Sub

    Private Sub RaiseError(ByVal ErrorCode As W32F_Errors, _
    Optional sExtra)
    Dim Win32Err As Long, Win32Text As String
    Win32Err = Err.LastDllError
    If Win32Err Then
    Win32Text = vbCrLf & "Error " & Win32Err & vbCrLf & _
    DecodeAPIErrors(Win32Err)
    End If
    Select Case ErrorCode
    Case W32F_FILE_ALREADY_OPEN
    Err.Raise W32F_FILE_ALREADY_OPEN, W32F_SOURCE, _
    "The file '" & sExtra & "' is already open." & Win32Text
    Case W32F_PROBLEM_OPENING_FILE
    Err.Raise W32F_PROBLEM_OPENING_FILE, W32F_SOURCE, _
    "Error opening '" & sExtra & "'." & Win32Text
    Case W32F_FILE_ALREADY_CLOSED
    Err.Raise W32F_FILE_ALREADY_CLOSED, W32F_SOURCE, _
    "There is no open file."
    Case W32F_Problem_seeking
    Err.Raise W32F_Problem_seeking, W32F_SOURCE, _
    "Seek Error." & vbCrLf & sExtra
    Case Else
    Err.Raise W32F_UNKNOWN_ERROR, W32F_SOURCE, _
    "Unknown error." & Win32Text
    End Select
    End Sub

    Private Function DecodeAPIErrors(ByVal ErrorCode As Long) As String
    Dim sMessage As String, MessageLength As Long
    sMessage = Space$(256)
    MessageLength = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0&, _
    ErrorCode, 0&, sMessage, 256&, 0&)
    If MessageLength > 0 Then
    DecodeAPIErrors = Left(sMessage, MessageLength)
    Else
    DecodeAPIErrors = "Unknown Error."
    End If
    End Function

Create the Test Sample

  1. Add a Form (Form1) to the project. (Visual Basic creates Form1 by default.)
  2. Add a Text Box (Text1) and 4 CommandButtons to the form with their respective Name and Caption properties set to cmdOpen, cmdClose, cmdRead, and cmdWrite.
  3. Add the following code to the Form:
          Option Explicit

    Dim F As Random

    Private Sub cmdClose_Click()
    F.CloseFile
    End Sub

    Private Sub cmdOpen_Click()
    F.OpenFile Text1.Text
    End Sub

    Private Sub cmdRead_Click()
    Dim Temp as Variant
    F.SeekAbsolute 0, 2 ' Seeks 2 bytes (0*2^32 + 2) = 1 character.
    Temp = F.ReadBytes(6)
    Debug.Print Temp
    F.SeekRelative -2 ' Seeks backward 1 character.
    Temp = F.ReadBytes(4)
    Debug.Print Temp
    End Sub

    Private Sub cmdWrite_Click()
    Dim B() As Byte
    B = "ABCDEFGHI" ' Each unicode character is 2 bytes.
    F.WriteBytes B()
    End Sub

    Private Sub Form_Load()
    Set F = New Random
    End Sub

    Private Sub Form_Unload(Cancel As Integer)
    Set F = Nothing
    End Sub
  4. Run the project.
  5. Type a dummy file name into the TextBox, such as c:\test.dat.
  6. Click cmdOpen, cmdWrite, cmdRead, and cmdClose (in that order).
RESULT: You should see the following output based on the random positioning prior to reading the written data:

BCD
DE

References

For additional information on the APIs used in this article, please see the following articles in the Microsoft Knowledge Base:
186063 INFO: Translating Automation Errors for VB/VBA (Long)



165942 How To Write Data to a File Using WriteFile API



189862 How To Do 64-bit arithmetic in VBA
For detailed descriptions of the APIs used in this article, consult the Platform SDK documentation available with Microsoft Visual C++ or Microsoft Visual Studio.

Propiedades

Id. de artículo: 189981 - Última revisión: 03/23/2009 - Revisión: 1

Comentarios