Microsoft KB Archive/189981

= How To Seek Past VBA's 2GB File Limit =

Article ID: 189981

Article Last Modified on 8/30/2004

-

APPLIES TO


 * Microsoft Visual Basic for Applications 5.0
 * Microsoft Visual Basic 4.0 Standard Edition
 * Microsoft Visual Basic 4.0 Professional Edition
 * Microsoft Visual Basic 4.0 32-Bit Enterprise Edition
 * Microsoft Visual Basic 5.0 Learning Edition
 * Microsoft Visual Basic 6.0 Learning Edition
 * Microsoft Visual Basic 5.0 Professional Edition
 * Microsoft Visual Basic 6.0 Professional Edition
 * Microsoft Visual Basic 5.0 Enterprise Edition
 * Microsoft Visual Basic 6.0 Enterprise Edition

-



This article was previously published under Q189981



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.</li>  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 </li> Run the project.</li> Type a dummy file name into the TextBox, such as c:\test.dat .</li> Click cmdOpen, cmdWrite, cmdRead, and cmdClose (in that order).</li></ol>

RESULT: You should see the following output based on the random positioning prior to reading the written data:

BCD

DE

<div class="references_section">