472,981 Members | 1,463 Online
Bytes | Software Development & Data Engineering Community
Post Job

Home Posts Topics Members FAQ

Join Bytes and contribute your articles to a community of 472,981 developers and data experts.

Direct File I/O in VBA

32,548 Expert Mod 16PB

By default VBA makes direct file I/O very hard to find. So much so that many will swear it isn't even supported. It is. AND, it does the job extremely fast. This Class Module handles direct file I/O as well as buffering. It even provides a routine for searching through a file for a simple string, as well as a simple string followed by a list of other data at specified offsets from where the original string was found.
Expand|Select|Wrap|Line Numbers
  1. Option Explicit
  3. Private Const conMaxBufLen As Long = 2 ^ &H14    '1,048,576 or &H100000
  5. Private strName As String, strBuffer As String
  6. Private intFileNo As Integer
  7. Private lngBufPos As Long, lngFilePos As Long, lngFileLen As Long
  9. 'Initialise() opens the specified save file.
  10. Public Function Initialise(Optional ByVal strFileName As String = "") As Boolean
  11.     lngBufPos = -1
  12.     lngFilePos = -1
  13.     Initialise = OpenSave(strFileName)
  14. End Function
  16. 'OpenSave() opens the file for update if not already open.
  17. Private Function OpenSave(Optional ByVal strFileName As String = "") As Boolean
  18.     Dim strMsg As String
  20.     On Error GoTo Err_OpenSave
  21.     OpenSave = True
  22.     If strFileName = "" Then Exit Function
  23.     strName = strFileName
  24.     If intFileNo > 0 Then Close #intFileNo
  25.     intFileNo = FreeFile()
  26.     Open strName For Binary Access Read Write Lock Write As #intFileNo
  27.     lngFileLen = LOF(intFileNo)
  28.     Exit Function
  30. Err_OpenSave:
  31.     strMsg = MultiReplace(conErr, "%N", Err.Number, _
  32.                                   "%D", Err.Description, _
  33.                                   "%L", vbNewLine) & _
  34.              vbNewLine & vbNewLine & _
  35.              "Retry?"
  36.     If CheckOp(strWarning:=strMsg, strTitle:="clsSave.OpenSave") Then Resume
  37.     OpenSave = False
  38. End Function
  40. 'ReadBuf() reads data into the (1MB) buffer.
  41. Private Sub ReadBuf(Optional ByVal lngPos As Long = -1)
  42.     Dim lngBufLen As Long
  44.     If lngPos = -1 Then lngPos = IIf(lngBufPos = -1, 0, lngFilePos - conDiskBuf)
  45.     If lngPos = lngBufPos Then Exit Sub
  46.     If intFileNo = 0 Then Stop
  47.     lngPos = lngPos And -conDiskBuf
  48.     lngBufLen = lngFileLen - lngPos
  49.     If lngBufLen < 0 Then Stop
  50.     If lngBufLen > conMaxBufLen Then lngBufLen = conMaxBufLen
  51.     If Len(strBuffer) <> lngBufLen Then strBuffer = String(lngBufLen, Chr(&HFF))
  52.     Get #intFileNo, lngPos + 1, strBuffer
  53.     lngBufPos = lngPos
  54.     lngFilePos = lngPos + lngBufLen
  55. End Sub
  57. 'ReadNum() returns a number value from the file.
  58. Public Function ReadNum(lngPos As Long, _
  59.                         Optional intLen As Integer = &H4) As Long
  60.     ReadNum = LongVal(ReadFile(lngPos, intLen))
  61. End Function
  63. 'ReadFile() returns an intLen long string from the file.
  64. Public Function ReadFile(lngPos As Long, intLen As Integer) As String
  65.     If intFileNo = 0 Then Stop
  66.     Select Case lngPos
  67.     Case Is < lngBufPos, Is > lngFilePos - intLen
  68.         ReadFile = String(intLen, &HFF)
  69.         Get #intFileNo, lngPos + 1, ReadFile
  70.     Case Else
  71.         ReadFile = Mid(strBuffer, lngPos - lngBufPos + 1, intLen)
  72.     End Select
  73. End Function
  75. 'WriteNum() writes a number value to the file at lngPos.
  76. Public Sub WriteNum(ByVal lngPos As Long, ByVal lngVal As Long, _
  77.                     Optional ByVal intLen As Integer = &H4)
  78.     Call WriteFile(lngPos, LongStr(lngVal, intLen))
  79. End Sub
  81. 'WriteFile() writes strWrite to the file at lngPos.
  82. Public Sub WriteFile(lngPos As Long, ByVal strWrite As String)
  83.     If intFileNo = 0 Then Stop
  84.     Put #intFileNo, lngPos + 1, strWrite
  85.     'Update buffer if there is any overlap
  86.     If lngPos > (lngBufPos - Len(strWrite)) And lngPos < lngFilePos Then
  87.         Select Case lngPos
  88.         Case Is < lngBufPos
  89.             strWrite = Right(strWrite, lngPos + Len(strWrite) - lngBufPos)
  90.             lngPos = lngBufPos
  91.         Case Is > lngFilePos - Len(strWrite)
  92.             strWrite = Left(strWrite, lngFilePos - lngPos)
  93.         End Select
  94.         Mid(strBuffer, lngPos - lngBufPos + 1) = strWrite
  95.     End If
  96. End Sub
  98. 'CloseFile() closes the file and tidies up the variables
  99. Private Sub CloseFile()
  100.     If intFileNo = 0 Then Exit Sub
  101.     Close #intFileNo
  102.     intFileNo = 0
  103. End Sub
  105. 'Search() returns the position (in the file) of the next occurrence of strText
  106. 'starting from lngPos where the extra parameter pairs (if passed) are also
  107. 'found in the locations passed.
  108. 'If not found then -1 returned.
  109. Public Function Search(lngPos As Long, ByVal strText As String, _
  110.                        ParamArray avarArgs() As Variant) As Long
  111.     Dim lngSize As Long, lngX As Long, lngY As Long, lngStrPos As Long
  112.     Dim strCheck As String
  114.     strText = FromSpecial(strText)
  115.     lngSize = Len(strText)
  116.     For lngX = LBound(avarArgs) To UBound(avarArgs) Step 2
  117.         lngY = avarArgs(lngX) + Len(FromSpecial(avarArgs(lngX + 1)))
  118.         If lngSize < lngY Then lngSize = lngY
  119.     Next lngX
  120.     'Logic relies on shunting by conDiskBuf so would fail if item larger
  121.     If lngSize > conDiskBuf Then Stop
  122.     If lngBufPos = -1 _
  123.     Or lngPos < lngBufPos _
  124.     Or lngPos > (lngFilePos - lngSize) Then Call ReadBuf(lngPos)
  125.     lngStrPos = lngPos - lngBufPos
  126.     Do
  127.         lngStrPos = InStr(lngStrPos + 1, strBuffer, strText, vbBinaryCompare)
  128.         Select Case lngStrPos
  129.         Case 0, Is > (Len(strBuffer) + 1 - lngSize)
  130.             'Not found, or main item found but no room in buffer to check others
  131.             If lngFilePos < lngFileLen Then
  132.                 If lngStrPos = 0 Then lngStrPos = Len(strBuffer) + 1 - lngSize
  133.                 lngStrPos = lngStrPos + conDiskBuf - Len(strBuffer) - 1
  134.                 Call ReadBuf
  135.             Else
  136.                 Search = -1
  137.                 Exit Do
  138.             End If
  139.         Case Else
  140.             For lngX = LBound(avarArgs) To UBound(avarArgs) Step 2
  141.                 lngY = lngStrPos + avarArgs(lngX)
  142.                 strCheck = FromSpecial(avarArgs(lngX + 1))
  143.                 If Mid(strBuffer, lngY, Len(strCheck)) <> strCheck Then Exit For
  144.             Next lngX
  145.             If lngX > UBound(avarArgs) Then
  146.                 Search = lngBufPos + lngStrPos - 1
  147.                 Exit Do
  148.             End If
  149.         End Select
  150.     Loop
  151. End Function
  153. 'CheckData() returns True if strCheck NOT found in the file at lngPos.
  154. Public Function CheckData(lngPos As Long, strCheck As String) As Boolean
  155.     If lngPos < lngBufPos _
  156.     Or lngPos > (lngFilePos - Len(strCheck)) Then Call ReadBuf(lngPos)
  157.     CheckData = (ReadFile(lngPos, Len(strCheck)) <> strCheck)
  158. End Function
  160. 'Class_Terminate() ensures all is tidied up before terminating.
  161. Private Sub Class_Terminate()
  162.     Call CloseFile
  163.     strName = ""
  164. End Sub
And, some supporting procedures from another module that are referenced by the above code :
Expand|Select|Wrap|Line Numbers
  1. 'ToSpecial() converts unprintable characters in strFrom into special Hex string
  2. Public Function ToSpecial(strFrom) As String
  3.     Dim strChar As String
  4.     Dim lngX As Long
  6.     For lngX = 1 To Len(strFrom)
  7.         strChar = Mid(strFrom, lngX, 1)
  8.         If strChar < " " _
  9.         Or strChar > "~" _
  10.         Or strChar = "\" Then _
  11.             strChar = "\" & ToSpChr(strChar)
  12.         ToSpecial = ToSpecial & strChar
  13.     Next lngX
  14. End Function
  16. 'ToSpChr() converts a character into its two representative hex characters
  17. Private Function ToSpChr(strChar As String) As String
  18.     Dim intChar As Integer
  20.     ToSpChr = "0"
  21.     If Asc(strChar) > &HF Then _
  22.         ToSpChr = Right(ToSpChr(Chr(Asc(strChar) \ &H10)), 1)
  23.     intChar = Asc(strChar) Mod &H10
  24.     If intChar > 9 Then intChar = intChar + 7
  25.     ToSpChr = ToSpChr & Chr(Asc("0") + intChar)
  26. End Function
  28. 'FromSpecial() converts \nn hex characters in a string to their char equivalent
  29. Public Function FromSpecial(strFrom) As String
  30.     Dim strChar As String
  31.     Dim lngX As Long
  33.     For lngX = 1 To Len(strFrom)
  34.         strChar = Mid(strFrom, lngX, 1)
  35.         If strChar = "\" Then
  36.             strChar = FromSpChr(UCase(Mid(strFrom, lngX + 1, 2)))
  37.             lngX = lngX + 2
  38.         End If
  39.         FromSpecial = FromSpecial & strChar
  40.     Next lngX
  41. End Function
  43. 'FromSpChr() converts two hex digits into their character equivalent
  44. Private Function FromSpChr(strVal As String) As String
  45.     FromSpChr = Chr(0)
  46.     If Left(strVal, 1) > "0" Then FromSpChr = FromSpChr(Left("0" & strVal, 2))
  47.     If Right(strVal, 1) > "9" Then strVal = Chr(Asc(Right(strVal, 1)) - 7)
  48.     FromSpChr = Chr(&H10 * Asc(FromSpChr) + Asc(Right(strVal, 1)) - Asc("0"))
  49. End Function
  51. 'LongVal() returns the value of a string
  52. Public Function LongVal(strVal) As Long
  53.     If Len(strVal) < &H4 Then _
  54.         strVal = strVal & String(&H4 - Len(strVal), vbNullChar)
  55.     LongVal = ((Asc(Mid(strVal, 4)) And &H7F) * &H1000000) Or _
  56.               (Asc(Mid(strVal, 3)) * &H10000) Or _
  57.               (Asc(Mid(strVal, 2)) * &H100&) Or _
  58.               Asc(Mid(strVal, 1))
  59.     If Asc(Mid(strVal, 4)) And &H80 Then LongVal = LongVal Or &H80000000
  60. End Function
  62. 'LongStr() returns the string equivalent of a numeric value.
  63. Public Function LongStr(lngVal As Long, _
  64.                         Optional intLen As Integer = &H4) As String
  65.     LongStr = Chr(lngVal And &HFF) & _
  66.               Chr((lngVal And &HFF00&) \ 2 ^ &H8) & _
  67.               Chr((lngVal And &HFF0000) \ 2 ^ &H10) & _
  68.               Chr(((lngVal And &HFF000000) \ 2 ^ &H18) And &HFF)
  69.     If intLen < &H4 Then LongStr = Left(LongStr, intLen)
  70. End Function

Unlike Class_Initialize() this must be called directly and is not an Event Procedure of the class. This needs to be called only once per session. The class can be re-used for closing and opening files once it's been initialised. It will call OpenSave() for you though, if passed.

Named thus as in my usage it's working with Save files from a game. It simply opens the specified file in the appropriate way.

This procedure manages reading from the file into the File Buffer for later work. It ensures that the buffer has the correct data to cover the position in the file specified by lngPos.

Reads a number and converts it to Long. Numbers can be variable lengths so this can be specified to ensure only the right number of Bytes are included in the number.

This reads the specified data from either the file or the buffer. In most cases this will read from the buffer and be as efficient as possible. However, when the data read crosses a buffer boundary it reads it directly from the file itself. The number of times this happens will depend on the data and the work, but generally speaking will be vanishingly rare.

Converts the number into a string of the correct number of Bytes then writes it.

This manages writing the value to the file. This is done directly (Unbuffered) in order to avoid the danger of any writes being left in the buffer should the system crash, or even your code crashing elsewhere. However, it also handles ensuring the buffer currently loaded, should it contain any part of the written data (Overlapping at the start, somewhere in the middle, or overlapping at the end.), is updated to include the changes.

Closes up the file but leaves the class available for another if required.

This one IS an Event Procedure and handles tidying up the class variables and data when the calling code finishes with it.

This code is used to search for patterns where the recognised data may not be contiguous.

An example might be for data where each record is preceded by a certain tag (EG "INFO".) but that's followed by something like a record number (4 bytes), followed by a name. So, if I'm looking for an record INFO record for John Smith I may call it as :
Expand|Select|Wrap|Line Numbers
  1. Dim objSave = New clsSave
  2. ...
  3. lngPtr = objSave.Search(0, "INFO", 8, "John Smith")
It first finds the first instance of "INFO" then checks for the occurrence of "John Smith" 8 bytes later. If not found then it finds the next occurrence of "INFO" and tries again. If the data is found it returns the address of the matching "INFO" text.

This allows the caller to determine if the specified text is found at the position indicated. Often used to check that a particular data structure is a valid example and not some other/random occurrence of the data.

EG. In the example above using "INFO", it may be that "INFO" is found elsewhere in the file as a random occurrence of that text. It could even be a numeric value that just happens to match. CheckData() enables the caller to check for other indicators that ensure it's a valid record found.

FromSpecial() & ToSpecial()
These allow numbers to be specified in strings directly and mixed with other text. For instance if you know the record number of "John Smith" is actually 49623 (Hex = 0000C1D7) then you could do a simpler search for "INFO\D7\C1\00\00" as these function procedures convert "\nn", where nn are two valid hexadecimal digits, to & from the characters that they represent in ASCII.

I hope that this can do either of two things for you :
  1. Give you a basic set of routines that you can use, out of the box, to handle your file manipulation.
  2. Get you started with the necessary principles and enable you to go further and tweak the code for your own needs.
Attribution is not necessary. I claim copyright, but I only insist nobody tries to claim copyright themselves for this code or any minor derivative thereof - thus restricting its free use.
Feb 13 '21 #1
1 5580
1,266 Expert 1GB
Thanks so much. I suspect your list of benefits is far too short. I've used the file I/O quite a bit, but there's a lot to learn here. The first compile attempt introduced me to the WebClient class. I've got a lot of reading to do.

Thank you!

Mar 31 '21 #2

Sign in to post your reply or Sign up for a free account.

Similar topics

by: Fran Tirimo | last post by:
I am developing a small website using ASP scripts to format data retrieved from an Access database. It will run on a Windows 2003 server supporting FrontPage extensions 2002 hosted by the company...
by: Ravi J | last post by:
Hello, I need to write an asp.net page that pushes a files to the user for download. The code I wrote works just fine, in that it sends a file to the user. But the HTML controls on the page are...
by: Zahid | last post by:
Hi, I have declared an array holding a custom declared structure. The structure looks like this: Private Structure MnuDataFrmFile Public menuGroup As String Public ItemDesc As String Public...
by: Joseph Geretz | last post by:
I'm working on an file transfer gateway using WSE with DIME for file attachments. Our goal is to replace our direct file repository access (via windows network folder sharre) with the Web Service...
by: RedHair | last post by:
I'd like to set up a file system for the ASP.NET 2.0 application to store user-uploaded files, since the members are more than 100,000 people, the basic requirements are as below: (1) The file...
by: SharpCoderMP | last post by:
hi, in my app i monitor the filesystem for changes with FileSystemWatchers. When the change is detected the app performs some actions using Shell32 to obtain information from the filesystem. now...
by: iwdu15 | last post by:
hi, i need to have a declare statement for an API to call a method in it, the only problem is that i dont neccessarily know where on the comp it will be. I kno it will be in my application folder,...
by: Steven Borrelli | last post by:
Hello, I am using the <?php include() ?statement on my website for organizational purposes. However, one of my includes contains some PHP code. Is there any way for the server to actually...
by: ldpfrog | last post by:
I was wondering how I would be able to open and take input from a text file through the internet. I was hoping that I could simply replace the filepath on my computer with the direct file online, but...
by: raymond_b_jimenez | last post by:
I need to download a file from an Intranet web site and feed it into a program on the PC where the browser is running. Browser is Internet Explorer. Both Javascript and VBscript are options. Which...
by: isladogs | last post by:
The next Access Europe meeting will be on Wednesday 4 Oct 2023 starting at 18:00 UK time (6PM UTC+1) and finishing at about 19:15 (7.15PM) The start time is equivalent to 19:00 (7PM) in Central...
by: giovanniandrean | last post by:
The energy model is structured as follows and uses excel sheets to give input data: 1-Utility.py contains all the functions needed to calculate the variables and other minor things (mentions...
by: NeoPa | last post by:
Hello everyone. I find myself stuck trying to find the VBA way to get Access to create a PDF of the currently-selected (and open) object (Form or Report). I know it can be done by selecting :...
by: NeoPa | last post by:
Introduction For this article I'll be using a very simple database which has Form (clsForm) & Report (clsReport) classes that simply handle making the calling Form invisible until the Form, or all...
by: Teri B | last post by:
Hi, I have created a sub-form Roles. In my course form the user selects the roles assigned to the course. 0ne-to-many. One course many roles. Then I created a report based on the Course form and...
by: nia12 | last post by:
Hi there, I am very new to Access so apologies if any of this is obvious/not clear. I am creating a data collection tool for health care employees to complete. It consists of a number of...
by: NeoPa | last post by:
Introduction For this article I'll be focusing on the Report (clsReport) class. This simply handles making the calling Form invisible until all of the Reports opened by it have been closed, when it...
by: isladogs | last post by:
The next online meeting of the Access Europe User Group will be on Wednesday 6 Dec 2023 starting at 18:00 UK time (6PM UTC) and finishing at about 19:15 (7.15PM). In this month's session, Mike...
by: GKJR | last post by:
Does anyone have a recommendation to build a standalone application to replace an Access database? I have my bookkeeping software I developed in Access that I would like to make available to other...

By using Bytes.com and it's services, you agree to our Privacy Policy and Terms of Use.

To disable or enable advertisements and analytics tracking please visit the manage ads & tracking page.