HOWTO: Seek Past VBA's 2GB File Limit

ID: Q189981

The information in this article applies to:

Microsoft Visual Basic for Applications version 5.0
Microsoft Visual Basic Standard, Professional, and Enterprise Editions, 32-bit only, for Windows, version 4.0
Microsoft Visual Basic Learning, Professional, and Enterprise Editions for Windows, versions 5.0, 6.0

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

Create a new VBA project.

Add a Class Module and set the Class Name to "Random".

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

Add a Form (Form1) to the project. (Visual Basic creates Form1 by default.)

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.

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

Run the project.

Type a dummy file name into the TextBox, such as c:\test.dat.

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:

Q186063 INFO: Translating Automation Errors for VB/VBA (Long)

Q165942 HOWTO: Write Data to a File Using WriteFile API

Q189862 HOWTO: 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.

Additional query words: gig gigabyte

Keywords : kbAPI kbSDKWin32 KbVBA kbVBp400 kbVBp500 kbVBp600
Version : WINDOWS:4.0,5.0,6.0
Platform : WINDOWS
Issue type : kbhowto