How To Seek Past VBA's 2GB File Limit

How To Seek Past VBA's 2GB File Limit
View products that this article applies to.
if (!loadTOCNode) {var loadTOCNode = function(){}}
This article was previously published under Q189981
On This Page
SUMMARY
MORE INFORMATION
Create the Sample Class
Create the Test Sample
REFERENCES
var sectionFilter = "type != 'notice' && type != 'securedata' && type != 'querywords'";
var tocArrow = "/library/images/support/kbgraphics/public/en-us/downarrow.gif";
var depthLimit = 10;
var depth3Limit = 10;
var depth4Limit = 5;
var depth5Limit = 3;
var tocEntryMinimum = 1;

Expand all Collapse all
if (kb_page_object)
{
kb_page_object.kb_imageExpandHoverText = 'Click to expand this image';
}


SUMMARY
When performing low-level random file I/O using the Seek, Get, and Put statement...
loadTOCNode(1, '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.
Back to the top
MORE INFORMATION
All file I/O ends up calling low-level Windows APIs, such as ReadFile, WriteFile...
loadTOCNode(1, 'moreinformation');

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.

Back to the top
Create the Sample Class
loadTOCNode(2, 'moreinformation');

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

Back to the top
Create the Test Sample
loadTOCNode(2, 'moreinformation');

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:
BCDDE
Back to the top
REFERENCES
For additional information on the APIs used in this article, please see the foll...
loadTOCNode(1, 'references');

For additional information on the APIs used in this article, please see the following articles in the Microsoft Knowledge Base:
186063 (http://support.microsoft.com/kb/186063/EN-US/ ) INFO: Translating Automation Errors for VB/VBA (Long) 165942 (http://support.microsoft.com/kb/165942/EN-US/ ) How To Write Data to a File Using WriteFile API 189862 (http://support.microsoft.com/kb/189862/EN-US/ ) 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.
Back to the top

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