ID: Q189981
The information in this article applies to:
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^30 bytes(2 GB). This article provides a sample class for random file I/O that allows access beyond the 2GB limit.
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:
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.
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.
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
1. Add a Form (Form1) to the project. (Visual Basic creates Form1 by
default.)
respective Name and Caption properties set to cmdOpen, cmdClose,
cmdRead, and cmdWrite.
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
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
For additional information on the APIs used in this article, please see the following articles in the Microsoft Knowledge Base:
ARTICLE-ID: Q186063
TITLE : INFO: Translating Automation Errors for VB/VBA (Long)
ARTICLE-ID: Q165942
TITLE : HOWTO: Write Data to a File Using WriteFile API
ARTICLE-ID: Q189862
TITLE : HOWTO: Do 64-bit arithmetic in VBA
(c) Microsoft Corporation 1998, All Rights Reserved. Contributions by Malcolm Stewart, Microsoft Corporation
Additional query words:
Keywords : kbAPI kbSDKWin32 KbVBA kbVBp400 kbVBp500 kbVBp600
Version : WINDOWS:4.0,5.0,6.0;
Platform : WINDOWS
Issue type : kbhowtoLast Reviewed: August 8, 1998