Notice: I'm going to move the latest one to the CodeBank. We can continue any discussion over there.
EDIT1: Ok, I've made some enhancements, knocked off my list, fixed a couple of bugs, and done testing. Everything in this post is updated for these changes. EDIT2: Made another change, 4:31pm central time, Apr, 12, 2022. EDIT3: Added an bOpenOnlyNoCreate option to the Initialization procedure of the class. This allows you to open a memory file that was created by another thread or process. Also included is a project named MemoryArrayReadTest for testing this. Also, I'm just going to show the source for the class (updated). Download the attached ZIP to see the rest of it. Also changed the code to deal with an error 1450 (out of resources) a bit better. EDIT4: Fixed a bug when specifying the vbString option. To fix the problem, it's now required that the string size (time 2, for Unicode) be an integer divisor of the system's granularity (&h10000 on my system). This will typically just be some power of 2. All the other allowed intrinsic types (vbByte, vbBoolean, vbInteger, vbLong, vbSingle, vbCurrency, vbDate, vbDouble, & vbDecimal) already meet this criteria. Actually, an adjustment was also made to the Decimal type to meet this criteria.
Ok, this is an idea I've been playing around with, inspired by some code by Dil seen here, as well as by The Trick.
My idea was to use those concepts and create a class that "looks like" an array (of any numeric data type of your choosing). The primary feature this will have that other typical VB6 arrays don't have is that the data is stored in far memory. These arrays can expand past our 2GB (or 4GB with LAA) VB6 limitations.
I'm posting here (and not in the CodeBank) because I'd like to open this up for discussion and critique. Also, although it seems to be working, I don't consider it quite finished just yet. Here's a todo list:
(DONE!) Fixed Length Strings?
(DONE!) Maybe leave a particular granular map open until it no longer works for the index specified.
(DONE!) Clean up (eliminate) some local variables.
Does initial file creation need to zero out the memory? It seems not, but MSDN doesn't seem to specify. (Seems to be ok, probably done by CreateFileMapping API).
(DONE!) Certain Long types need to be changed to Decimal types if we're truly going to address more than 4GB.
I've attached a working project, but here's the code from the class module named MemoryBasedArray.
Code:
' Ideas herein were inspired by some work that Dilettante & The Trick (vbforums.com) have done.
'
' With this class, you can create an array that uses "far" memory,
' and isn't limited to the 2GB (or 4GB with LAA) that VB6 is limited to.
'
' Initialize must be called immediately after instantiation.
' Then, the Value property (Get & Let) can be used.
'
Option Explicit
'
Private Type SYSTEM_INFO
Reserved1(27&) As Byte
dwAllocationGranularity As Long ' For purposes herein, this is all we need.
Reserved2(3&) As Byte
End Type
'
Private Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" (ByVal hFile As Long, ByVal lpFileMappigAttributes As Long, ByVal flProtect As Long, ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, ByVal lpName As String) As Long
Private Declare Function MapViewOfFile Lib "kernel32" (ByVal hFileMappingObject As Long, ByVal dwDesiredAccess As Long, ByVal dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, ByVal dwNumberOfBytesToMap As Long) As Long
Private Declare Function OpenFileMapping Lib "kernel32" Alias "OpenFileMappingA" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal lpName As String) As Long
Private Declare Function UnmapViewOfFile Lib "kernel32" (ByVal lpBaseAddress As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Long, ByRef Source As Long, ByVal Length As Long)
Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (ByRef Destination As Long, ByVal Length As Long)
Private Declare Sub GetSystemInfo Lib "kernel32" (ByRef lpSystemInfo As SYSTEM_INFO)
Private Declare Function VariantChangeType Lib "oleaut32" (Dest As Variant, src As Variant, ByVal wFlags As Integer, ByVal vt As Long) As Long
'
Private mbInit As Boolean
Private mhMemFile As Long
Private miVarType As Long
Private miItemBytes As Long
Private mvMaxCount As Variant ' Decimal.
Private miVariantOffset As Long
Private miGranularity As Long
'
Private mpMapView As Long
Private mdwViewHigh As Long
Private mdwViewLow As Long
'
Public Sub Initialize(ByRef sUniqueName As String, iVarType As VBA.VbVarType, iMaxItemCount As Variant, Optional iFixedStringCharLen As Long = 10&, Optional bOpenOnlyNoCreate As Boolean = False)
'
' sUniqueName is a system-wide thing. If other programs are using CreateFileMapping,
' the sUniqueName must be unique with respect to those, and not only names used within this project.
'
' iVarType is simply the variable type you'll be storing in this array.
' Or, fixed length strings (not the same as VB6's fixed length strings) are allowed.
'
' iMaxItemCount is the maximum (not necessily used) number of items in the array.
' You will get an error if you overflow this when using the Value properties.
' Note that far memory is allocated based on this iMaxItemCount argument.
' This iMaxItemCount must be a numeric integer. It's not a Long so that even more than a Long's limits can be used.
'
' If iVarType = vbString then iFixedStringCharLen is examined for how long they should be.
' As a note, these strings CAN'T contain vbNullChar, as that's reserved for padding in these things.
' Also, their length must an integer divisor of the system's granularity (typically some power of 2).
'
If mbInit Then Exit Sub ' Only allow this to be called once.
If Not IsNumeric(iMaxItemCount) Then Err.Raise 13&, TypeName(Me), "iMaxItemCount must be numeric."
If iMaxItemCount < 1& Then Err.Raise 5&, TypeName(Me), "Count must be at least 1."
'
' Save granularity.
miGranularity = MemAllocGranularity
'
' The only allowed types are: vbBoolean, vbByte, vbCurrency, vbDate, vbDecimal, vbDouble, vbInteger, vbLong, vbSingle, or vbString.
Select Case iVarType
Case vbByte: miItemBytes = 1&: miVariantOffset = 8& ' These are the length (bytes) and offset with a variant for our data types.
Case vbBoolean, vbInteger: miItemBytes = 2&: miVariantOffset = 8& ' In most cases (all but Decimal), a variant stores data at an 8 byte offset.
Case vbLong, vbSingle: miItemBytes = 4&: miVariantOffset = 8&
Case vbCurrency, vbDate, vbDouble: miItemBytes = 8&: miVariantOffset = 8&
Case vbDecimal: miItemBytes = 16&: miVariantOffset = 0& ' This is the one case where all 14 bytes of the variant's data are used.
Case vbString
' This one needs a bit of special handling.
miItemBytes = iFixedStringCharLen * 2& ' Unicode.
Select Case True
Case miGranularity < miItemBytes
Err.Raise 6&, TypeName(Me), "Fixed string length (" & CStr(iFixedStringCharLen) & ") overflow. They can't be longer than the system's granularity / 2 (" & CStr(miGranularity / 2) & ")."
Case iFixedStringCharLen < 1&
Err.Raise 6&, TypeName(Me), "Fixed string length underflow. Length: " & CStr(iFixedStringCharLen)
Case miGranularity Mod miItemBytes <> 0
Err.Raise 6&, TypeName(Me), "Fixed string length * 2 (for Unicode) (" & CStr(iFixedStringCharLen) & ") not an even divisor of the system's granularity (" & CStr(miGranularity) & ")."
End Select
'
miVariantOffset = 8& ' But, in this case, it's the BSTR pointer.
Case Else: Err.Raise 13&, TypeName(Me), "Invalid variable type specified."
End Select
'
' Save our initialization properties.
miVarType = iVarType
mvMaxCount = CDec(iMaxItemCount)
'
' Figure out byte size of Mapped File, and round UP to a multiple of MemAllocGranularity.
Dim vTotalBytes As Variant
vTotalBytes = CDec(miItemBytes) * mvMaxCount
vTotalBytes = Int((vTotalBytes - CDec(1&) + CDec(miGranularity)) / CDec(miGranularity)) * CDec(miGranularity)
'
' Copy low and high into MapViewOfFile offset arguments.
Dim dwMaximumSizeHigh As Long
Dim dwMaximumSizeLow As Long
'
' Variant structure with a Decimal.
' VariantType As Integer ' Reserved, to act as the Variant Type when sitting in a 16-Byte-Variant. Equals vbDecimal(14) when it's a Decimal type.
' Base10NegExp As Byte ' Base 10 exponent (0 to 28), moving decimal to right (smaller numbers) as this value goes higher. Top three bits are never used.
' sign As Byte ' Sign bit only. Other bits aren't used.
' Hi32 As Long ' Mantissa.
' Lo32 As Long ' Mantissa.
' Mid32 As Long ' Mantissa.
CopyMemory dwMaximumSizeHigh, ByVal PtrAdd(VarPtr(vTotalBytes), 12&), 4& ' Mid32
CopyMemory dwMaximumSizeLow, ByVal PtrAdd(VarPtr(vTotalBytes), 8&), 4& ' Lo32
'
' Create our memory file.
Const INVALID_HANDLE_VALUE As Long = -1&
Const PAGE_READWRITE As Long = 4&
Const FILE_MAP_WRITE As Long = 2&
Const FILE_MAP_READ As Long = 4&
'
If Not bOpenOnlyNoCreate Then
mhMemFile = CreateFileMapping(INVALID_HANDLE_VALUE, 0&, PAGE_READWRITE, dwMaximumSizeHigh, dwMaximumSizeLow, sUniqueName)
If mhMemFile = 0& Then
If Err.LastDllError = 1450& Then
Err.Raise Err.LastDllError, TypeName(Me), "CreateFileMapping error ERROR_NO_SYSTEM_RESOURCES. This probably means you don't have enough memory in this computer to map file(s) as large as you're trying to, or maybe memory is full with other executing programs."
Else
Err.Raise Err.LastDllError, TypeName(Me), "CreateFileMapping API system error."
End If
End If
'
Const ERROR_ALREADY_EXISTS As Long = 183&
If Err.LastDllError = ERROR_ALREADY_EXISTS Then CloseMemFile: Err.Raise 55&, TypeName(Me), sUniqueName & " already open."
Else
mhMemFile = OpenFileMapping(FILE_MAP_READ + FILE_MAP_WRITE, 0&, sUniqueName)
If mhMemFile = 0& Then Err.Raise Err.LastDllError, TypeName(Me), "OpenFileMapping API system error. Make sure the file exists."
End If
'
' All done and ready to be used.
mbInit = True
End Sub
Private Sub Class_Terminate()
' When all handles to the mapped object are closed, it disappears.
' When in the IDE, abnormal termination can leave the file open,
' and only way to get rid of it is to restart the IDE.
' When compiled, it's not a problem.
'
CloseMemFile
End Sub
Private Sub CloseMemFile()
If mpMapView Then
ApiZ UnmapViewOfFile(mpMapView)
mpMapView = 0&
End If
If mhMemFile Then
ApiZ CloseHandle(mhMemFile)
mhMemFile = 0&
End If
End Sub
Public Property Let Value(index As Variant, vValue As Variant)
' Zero based index. It can be any numeric value, but will always be treated as an integer,
' and internally, it'll be handled as a Decimal.
'
' If you need an index larger than 2147483647 (&h7fffffff), you can cast a string to a decimal
' using something like: CDec("99999999999"), or just use Decimal types in the first place for your indices.
'
If Not mbInit Then Exit Property
'
' Make sure we've got valid arguments.
If VarType(vValue) <> miVarType Then CloseMemFile: Err.Raise 13&, TypeName(Me), "Value type doesn't match initialization type: " & TypeName(vValue)
Dim vDecIdx As Variant
vDecIdx = ValidateIndex(index)
'
' Create a map view of our memory file.
Dim iGranOffset As Long
iGranOffset = CreateSingleItemMapping(vDecIdx)
'
' Put data into memory mapped file.
If miVarType <> vbString Then
CopyMemory ByVal PtrAdd(mpMapView, iGranOffset), ByVal PtrAdd(VarPtr(vValue), miVariantOffset), miItemBytes
Else
ZeroMemory ByVal PtrAdd(mpMapView, iGranOffset), miItemBytes
Dim iChars As Long
iChars = miItemBytes \ 2&
Dim s As String
s = String$(iChars, vbNullChar) ' Create a buffer.
Mid$(s, 1&, Len(vValue)) = vValue ' s is now padded with vbNullChar if necessary.
CopyMemory ByVal PtrAdd(mpMapView, iGranOffset), ByVal StrPtr(s), miItemBytes ' We ignore the BSTR zero terminator.
End If
End Property
Public Property Get Value(index As Variant) As Variant
' Zero based index. See notes in "Let Value" property.
'
If Not mbInit Then Exit Property
'
' Make sure we've got valid arguments.
Dim vDecIdx As Variant
vDecIdx = ValidateIndex(index)
'
' Create a map view of our memory file.
Dim iGranOffset As Long
iGranOffset = CreateSingleItemMapping(vDecIdx)
'
' Get data from memory mapped file.
If miVarType <> vbString Then
Value = CLng(0&)
If miVarType <> vbLong Then ApiE VariantChangeType(Value, Value, 0&, miVarType), "VariantChangeType" ' Make our variant the correct type.
CopyMemory ByVal PtrAdd(VarPtr(Value), miVariantOffset), ByVal PtrAdd(mpMapView, iGranOffset), miItemBytes
Else ' Handle strings.
Dim iChars As Long
iChars = miItemBytes \ 2&
Dim s As String
s = String$(iChars, vbNullChar) ' Create a buffer.
CopyMemory ByVal StrPtr(s), ByVal PtrAdd(mpMapView, iGranOffset), miItemBytes
' Now, trim to vbNullChar.
Dim i As Long
i = InStr(s, vbNullChar)
If i Then s = Left$(s, i - 1&)
Value = s
End If
End Property
Private Function ValidateIndex(index As Variant) As Variant ' vDecIdx is returned.
If Not IsNumeric(index) Then CloseMemFile: Err.Raise 9&, TypeName(Me), "Bad index type: " & TypeName(index)
Dim vDecIdx As Variant
vDecIdx = CDec(index)
If vDecIdx < 0& Or (vDecIdx + 1&) > mvMaxCount Then CloseMemFile: Err.Raise 9&, TypeName(Me), "Bad index range: " & CStr(vDecIdx)
If vDecIdx <> Int(vDecIdx) Then CloseMemFile: Err.Raise 9&, TypeName(Me), "Bad index value: " & CStr(vDecIdx)
'
ValidateIndex = vDecIdx
End Function
Private Function CreateSingleItemMapping(ByVal vDecIdx As Variant) As Long
' The iGranOffset is returned, which is an offset in the "View" to the specific item requested.
' mpMapView is also set.
'
' Convert vDecIdx into a byte offset.
vDecIdx = vDecIdx * CDec(miItemBytes)
'
' Calculate an offset that appreciates granularity.
Dim vTemp As Variant
vTemp = Int(vDecIdx / CDec(miGranularity)) ' Rounds down, preserving Decimal type.
vTemp = vTemp * CDec(miGranularity) ' This can now be used in MapViewOfFile API call.
CreateSingleItemMapping = vDecIdx - vTemp ' This provides an offset for addressing a single item.
'
' Copy low and high into MapViewOfFile offset arguments.
Dim dwFileOffsetHigh As Long
Dim dwFileOffsetLow As Long
'
' Variant structure with a Decimal.
' VariantType As Integer ' Reserved, to act as the Variant Type when sitting in a 16-Byte-Variant. Equals vbDecimal(14) when it's a Decimal type.
' Base10NegExp As Byte ' Base 10 exponent (0 to 28), moving decimal to right (smaller numbers) as this value goes higher. Top three bits are never used.
' sign As Byte ' Sign bit only. Other bits aren't used.
' Hi32 As Long ' Mantissa.
' Lo32 As Long ' Mantissa.
' Mid32 As Long ' Mantissa.
CopyMemory dwFileOffsetHigh, ByVal PtrAdd(VarPtr(vTemp), 12&), 4& ' Mid32
CopyMemory dwFileOffsetLow, ByVal PtrAdd(VarPtr(vTemp), 8&), 4& ' Lo32
'
' Make sure we need to do something.
If mpMapView = 0& Or mdwViewHigh <> dwFileOffsetHigh Or mdwViewLow <> dwFileOffsetLow Then
If mpMapView Then ApiZ UnmapViewOfFile(mpMapView)
mdwViewHigh = 0&
mdwViewLow = 0&
'
' Create a mapview of our memory file.
Const FILE_MAP_WRITE = 2&
Const FILE_MAP_READ = 4&
mpMapView = MapViewOfFile(mhMemFile, FILE_MAP_READ + FILE_MAP_WRITE, dwFileOffsetHigh, dwFileOffsetLow, miGranularity)
If mpMapView = 0& Then CloseMemFile: Err.Raise Err.LastDllError, TypeName(Me), "MapViewOfFile system error."
'
mdwViewHigh = dwFileOffsetHigh
mdwViewLow = dwFileOffsetLow
End If
End Function
Private Function MemAllocGranularity() As Long
' When using MapViewOfFile, the quad_word offset must be a multiple of this granularity (per MSDN).
Dim si As SYSTEM_INFO
GetSystemInfo si
MemAllocGranularity = si.dwAllocationGranularity
End Function
Private Function PtrAdd(ByVal Ptr As Long, ByVal iOffset As Long) As Long
' For adding (or subtracting) a small number from a pointer.
PtrAdd = (Ptr Xor &H80000000) + iOffset Xor &H80000000
End Function
Private Function ApiZ(ApiReturn As Long, Optional sApiCall As String) As Long
' This one is for API calls that report error by returning ZERO.
'
If ApiReturn <> 0& Then
ApiZ = ApiReturn
Exit Function
End If
'
Dim sErr As String
If Len(sApiCall) Then
sErr = sApiCall & " error " & CStr(Err.LastDllError)
Else
sErr = "API Error " & CStr(Err.LastDllError)
End If
'
Dim InIDE As Boolean: Debug.Assert MakeTrue(InIDE)
If InIDE Then
Debug.Print sErr
Stop
Else
Err.Raise vbObjectError + 1147221504, TypeName(Me), sErr
End If
End Function
Private Sub ApiE(ApiReturn As Long, Optional sApiCall As String)
' Just a general error processing procedure for API errors.
' For API calls where 0& is OK.
'
If ApiReturn = 0& Then Exit Sub
'
Dim sErr As String
If Len(sApiCall) Then
sErr = sApiCall & " error " & CStr(ApiReturn)
Else
sErr = "API Error " & CStr(ApiReturn)
End If
'
Dim InIDE As Boolean: Debug.Assert MakeTrue(InIDE)
If InIDE Then
Debug.Print sErr
Stop
Else
Err.Raise vbObjectError + 1147221504 - ApiReturn, TypeName(Me), sErr
End If
End Sub
Private Function MakeTrue(ByRef b As Boolean) As Boolean
b = True
MakeTrue = True
End Function
The Value properties are the default, so you can truly use it like an array, if you want.
Last edited by Elroy; Jul 3rd, 2022 at 05:50 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Ok, I feel like I've tested the edge conditions. A couple of people have given me reputation, but nobody seems to want to comment.
I'll leave it out here for a week or so, and then put it into the codebank if nobody has anything to say.
In particular, it'd be nice if there were some documentation that states that CreateFileMapping actually hands you zeroed memory.
And also, a similar question came up in another thread. But, I'm guessing that things get cached to virtual memory just based on how much memory we ask for here, and how much memory is actually in the machine.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Also, as another point, one might ask how we actually address this "far" memory. And this stumped me as well until I actually got into it.
Basically, there are three mechanisms that allow us to do this:
1) When we create our memory file, we must supply both dwMaximumSizeHigh and dwMaximumSizeLow to the API call. This allows us to allocate more than 4GB, with what is essentially an 8-byte-unsigned-integer (uint64, unsigned-LongLong).
2) When we read/write to the file, we create a window into it (called a "View"). This view can be any size we like (within our VB6's 4GB). Apparently, there are behind-the-scenes mechanisms that read-and-write to the larger file using this "View", monitoring when the "View" changes for writes.
3) When actually creating that "View", again, we must specify dwFileOffsetHigh and dwFileOffsetLow, such that the "View" fits into our memory, but it's only a section of the larger file. That quad_word makes an offset, and we also supply dwNumberOfBytesToMap to make a "View".
I just found it all interesting, so I thought I'd outline it.
Last edited by Elroy; Apr 12th, 2022 at 04:35 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
It seems promising, to overcome some of the limitations we talked about here.
Yes, it was your thread that actually got me thinking about this. I mean, we've all got at least 8GB these days (if not 32GB), but VB6 struggles to use it. I just thought I'd break down that barrier.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
sometimes i get the error.
1450 CreateFileMapping API system error
Yokesee, can you say more about the circumstances in which you see this error?
If you use the "Stop" button on the IDE, there's a good chance that you'll leave that memory file open. It doesn't crash the IDE, but it does leave the file's memory allocated. If you exit, and restart, the IDE, it does get cleared then.
But I'll try and figure it out. Ohhh, how much memory is in your machine? And is it 32-bit or 64-bit Windows?
I'm actually not positive that all this works on Windows 32-bit. I need to check on that as well.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
If my understanding of Address Windowing Extensions is correct, a 32bit virtual address space can be mapped to use up to 64GB of physical RAM. Have you looked at AllocateUserPhysicalPages?
I closed the ide not return the error.
I have windows 10 64bits and 32GB of ram.
I had a program consuming a lot of ram, that may be the problem.
Tomorrow I do more tests.
I closed the ide not return the error.
I have windows 10 64bits and 32GB of ram.
I had a program consuming a lot of ram, that may be the problem.
Tomorrow I do more tests.
That'd be great. Thank you.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Interesting. Could this be expanded to be utilized with a large UDT array or is that a bridge too far.
Edit
I have a large UDT array that is shared among multiple threads (structure is protected with CS) that consumes the bulk of the memory this particular app uses. Putting this outside 4gb would be v useful.
Last edited by vbwins; Apr 13th, 2022 at 03:22 AM.
You would have to write a specific class for each specific UDT.
Also when the items in the UDT are not of the same size then it would be quite cumbersome.
Think about strings items or items containing arrays of items themselves.
Especially when you want to remove/replace items in the middle of the array.
vbwins, I've thought about UDTs. One thing it would depend on is what you stored in the UDTs. If it was all intrinsic variables (and fixed length strings) it'd be pretty easy. However, once you start including object references, BSTR strings, or nested arrays, things start getting more complicated.
So, if you're up for it, how about posting the declaration for this UDT you're talking about.
Also, you mentioned "multiple threads". I could easily add an OpenExistingMemoryFile call in that class which would allow you to open an existing file that was created by another thread or process. In fact (in a much simpler form), Dilettante had it set up precisely that way. I think I'll go ahead and add that anyway. Just as a note, when doing that, you're responsible for your own marshalling.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
And hey, another idea (if your UDT doesn't contain any pointers [object references, nested arrays, BSTR strings]), you could just use LenB() on one of them, figure out their length, and then create a fixed-length-string array with my code in the OP. And then, just use CopyMemory and stuff the UDT items into a String as they're placed into the far memory array. And then do the reverse to get them back out. That'd be very easy, and fast as well. Again, if you post your UDTs declaration, I might even do that for you.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
sometimes i get the error.
1450 CreateFileMapping API system error
Ok, I figured this one out. Basically, that 1450 means you're out of memory. Or, more specifically, ERROR_NO_SYSTEM_RESOURCES. When the class sees this error, I've changed the error message to the following:
CreateFileMapping error ERROR_NO_SYSTEM_RESOURCES. This probably means you don't have enough memory in this computer to map file(s) as large as you're trying to, or maybe memory is full with other executing programs.
I'll post those changes to the OP momentarily.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
[*]Does initial file creation need to zero out the memory? It seems not, but MSDN doesn't seem to specify. (Seems to be ok, probably done by CreateFileMapping API).
Couldn't resist a reason to go trawling.
First, CreateFileMappingA just calls RtlAnsiStringToUnicodeString and then calls CreateFileMappingW. (As is almost always true. VB strings are Unicode anyway, I don't know why people call ANSI APIs just so VB converts the string to ANSI, then the ANSI API converts it back to Unicode and calls the W API, when you can just call it yourself and use StrPtr. StrPtr isn't so scary.)
CreateFileMappingW is a wrapper for NtCreateSection (as the others are wrappers for NtOpenSection and NtMapViewOfSection. MapViewOfFile, btw, is nothing but a redirect to MapViewOfFileEx with lpBaseAddress=NULL)
NtCreateSection is a wrapper for MmCreateSection.
MmCreateSection does indeed use RtlZeroMemory to 0 the section (memory allocated by ExAllocatePoolWithTag).
@yoksee,
- Multiple views on a file are coherent if they are derived from
the same file mapping object. If a process opens a file,
creates a mapping object, duplicates the object to another
process... If both processes map a view of the file, they will
both see a coherent view of the file's data... they will
effectively be viewing shared memory backed by the file.
You should be able to use DuplicateHandle with the mapping object.
Last edited by fafalone; Apr 15th, 2022 at 07:34 AM.
@Fafalone: Regarding CreateFileMappingA vs CreateFileMappingW. Yeah, I just copied Dil's API declarations. I saw the ...A, but never took the time to switch it over, thinking that it's just our internal (memory) file name so it's not really a big deal. But yeah, I've switched over many API calls in the past. I'll make a note and switch this one over as well.
@yokesee: There's already an example of that in the ZIP file attached to the OP. There are two projects in there: 1) for illustrating the whole concept of arrays in far memory, and 2) a second project for illustrating that these arrays can be read (and even written) from an entirely separate process.
--------------
Also, I've thought of a couple enhancements I'm going to make before posting it all in the CodeBank:
GetValues/SaveValues procedures for getting/saving a range of values with all one call. I just thought that might be handy.
LoadFromDisk/SaveToDisk methods where we can load/save the entire memory file to disk if we so desire. This will require API file reading/writing, as the memory image may be larger than 2GB.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
I just started to get some basic understanding on your class, and I wanted to ask you a couple of questions, that may advance my understanding so I don't have to figure all by myself.
One question is if as is, it can handle fixed length UDTs arrays.
Another one if it can handle arrays of variable length Strings.
Also, if it could handle both arrays in just one file.
I had another question regarding if the size of the arrays could be enlarged after creation (sort of ReDim) but I think I could adapt my code to know in advance how many elements I'll need to store.
Anyway I think it is also something interesting to know.
One question is if as is, it can handle fixed length UDTs arrays.
Ok, the answer to all of these questions is sort of "Yes" and "No". As it currently exists, it's only designed to handle VB6's intrinsic types (vbByte, vbBoolean, vbInteger, vbLong, vbSingle, vbCurrency, vbDate, vbDouble, vbDecimal, & vbString). However, it could fairly easily be rewritten to handle a UDT. You'd just need to rework it to accept your UDT, and basically take out that iVarType argument in the Initialize call. And then, you'd have to patch up that Select Case in Initialize so it could use the size (LenB) of your UDT for the item size. And then, for the Value properties, just pass in your UDT items.
A word about UDTs with pointers. It'd depend on how you actually did it, but the pointers could be maintained, but they would alias any strings, and not increment any reference counts for objects. With respect to either of those, you must be very careful.
Originally Posted by Eduardo-
Another one if it can handle arrays of variable length Strings.
This is actually a tougher one. The way it's currently designed, it expects each item (record, element, whatever) to be the same size. There is a vbString option, but it requires that you specify the iFixedStringCharLen, which is the maximum size of any string. And they return space-padded, much like fixed length strings. To truly handle variable length BSTR strings would require some pretty major reworking.
Originally Posted by Eduardo-
Also, if it could handle both arrays in just one file.
Both arrays? I'm confused. You could certainly instantiate as many copies of this thing as you wanted, each storing a different array. Just be sure each instantiation uses a different sUniqueName when calling Initialize.
Originally Posted by Eduardo-
I had another question regarding if the size of the arrays could be enlarged after creation (sort of ReDim) but I think I could adapt my code to know in advance how many elements I'll need to store.
This is another tough one. In Initialize, the CreateFileMapping call is made (kernel32.dll), and, as part of that call, you specify the maximum amount of memory you'll need. In fact, it's all allocated right then (part of the Initialize call).
So, about the only way to do this is to instantiate another copy, specifying a larger iMaxItemCount value, and then move the original array into the new one.
----------------------------
These are all good ideas. If I get motivated, maybe I'll work on some of them.
Take Care,
Elroy
Last edited by Elroy; Jun 29th, 2022 at 03:55 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
OK thanks.
About the mixing arrays question, I guess I was a bit confused. Yes, I can launch as many of these mapped files as I need, no problem.
About the variable length Strings, it would be for not wasting available RAM.
They are paths, millions of paths. I could set the fixed size to MAX_PATH and perhaps in another array the actual Len, and make a Left$ every time I need to get one (because paths with trailing spaces could be a problem elsewhere in the program).
But paths can actually be longer than MAX_PATH, and how much longer? I wonder...
I also want max speed, worth to mention.
About the Redim Preserve... I'm already thinking in doing it counting the total number in advance.
About being able to work with the UDT array, I have no other (practical) way. It is a fixed length UDT and there are only numbers (Long, Single, Byte and Boolean. But quite a few).
With my current approach without this technique, I can handle up to roughly 450,000 files. I intend to extend that to several millions, to all that the RAM allows.
About being able to work with the UDT array, I have no other (practical) way. It is a fixed length UDT and there are only numbers (Long, Single, Byte and Boolean. But quite a few).
You know? Just thinking about this, if you were willing to serialize your UDTs into a string, and then use that vbString option I provide, passing in the serialized length into iFixedStringCharLen (the Len(SerializedUDT)), you could use it as it is. Just un-serialize them when you get them back. A little "shim" function between your work and the class (both directions).
Originally Posted by Eduardo-
About the variable length Strings, it would be for not wasting available RAM.
Here's the problem. Basically, imagine all you've got is a file opened with VB6's Open...Binary. How do we design a "database" of variable length strings?
Back in the early 1980s, I had a partner who actually did that. Basically, he just had a small header on the beginning of each string that told him how long each string was. That way, he could jump from string to string. It wasn't random access though. We could do something like that.
Do you need to identify these strings by something other than their value and index number? That would require some kind of key like a collection. Also, will they be deleted with new ones added? That would require an occasional garbage collector.
IDK, it seems like quite a bit of work, but using far memory would certainly be much faster than doing it all to disk.
---------------
ADDED: Also, as I'm sure you know, this does break VB6's 2GB barrier (4GB with LAA), but you can still run out of memory, depending on how much free memory is actually in your machine.
Last edited by Elroy; Jun 29th, 2022 at 07:03 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Humm, no Elroy. I need to use this arrays pretty much as arrays, as they are now.
The UDTs need to be accessible by the index and by reference (not any copy, not to think of serializations), and be able to very fast be compared some member value, millions of comparisons (by walking the index) of a value against some reference value, or another value against another reference value (for values I mean UDT members).
About the paths, I'm thinking if there is no way to store a number instead of the String with the path, or at least something shorter that can identify a file and be converted back to a path by some API. I mean: there must be some way to identify a file in Windows other than the path.
Using the disk: no way, it would take days to run. It needs to be very fast.
I'm reading a bit more in the code, and I see that it uses CopyMemory... so maybe it is not what I need. I would need something, if not as fast, at least not far from to the original array speed.
Or maybe I could use this for the paths, the paths array doesn't need much speed.
For the UDTs I'm thinking to use workers processes and divide the work (dividing the data into several processes).
About the paths, I'm thinking if there is no way to store a number instead of the String with the path, or at least something shorter that can identify a file and be converted back to a path by some API. I mean: there must be some way to identify a file in Windows other than the path.
OT: it seems it is possible, but not as straightforward like PathFromID and IDFromPath as I would desire, but a bit more complex.
Eduardo, if you were keeping track of the entire path separately, and not trying to store it as well, there may be some shortcuts you can take.
For one, you could call GetShortPathName to get a file name that was at most 12 characters long. And, I believe these 8.3 file names are always ANSI, so you could shorten them to a true 12 bytes.
And then, just use a 12 for my iFixedStringCharLen argument in Initialize, and you could then store "a ton" of file names.
However, I'm not sure what you're trying to do though, and if you could ignore the full folder/path of the files.
Also, I'm not sure how we're going to get to Far Memory without doing a bit of CopyMemory. And that still going to be lightning fast compared to anything that's disk I/O based.
Also, that GetShortPathName does depend on Windows having 8.3 aliasing turned on, but it's on by default on all Windows Desktop versions, but not necessarily all server versions.
-----------
Also, just FYI, that GetShortPathName works on full paths too. So, if you knew a maximum of how deep your sub-folders were, you could set some length limits that were far less than 260. That 260 is a Unicode number though so it's actually 520 bytes.
Last edited by Elroy; Jun 30th, 2022 at 09:49 AM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
For one, you could call GetShortPathName to get a file name that was at most 12 characters long. And, I believe these 8.3 file names are always ANSI, so you could shorten them to a true 12 bytes.
That feature can be disabled, it is not guaranteed.
That feature can be disabled, it is not guaranteed.
Correct, it was just an idea.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
I made something simple to test the speed but it crashed.
This is the code of Form1 (using your test program):
Code:
Option Explicit
'
Dim oLong As MemoryBasedArray
Dim oDbl As MemoryBasedArray
Dim oStr As MemoryBasedArray
'
Private Sub Form_Load()
' This works for larger than 4GB too, but not on my 16GB machine with all the above still in memory.
Set oStr = New MemoryBasedArray
oStr.Initialize "StrTest", vbString, 700000, 300&
'
oStr.Value(0&) = "aaaa"
oStr.Value(1&) = "bbbbbbbbbbbb" ' Too long so it'll be truncated.
oStr.Value(2&) = vbNullString
oStr.Value(300000) = "dddddddd"
'
Debug.Print "'"; oStr.Value(0&); "'"
Debug.Print "'"; oStr.Value(1&); "'"
Debug.Print "'"; oStr.Value(2&); "'"
Debug.Print "'"; oStr.Value(3&); "'"
Debug.Print "'"; oStr.Value(4&); "'"
Dim c As Long
Stop
For c = 10 To 500000
If oStr.Value(c) <> oStr.Value(c - 1) Then
Stop
End If
Next
Stop
End Sub
Hmmm, weird. It crashes at wildly different index numbers, no pattern at all.
I've got something else I need to do this evening, but I'll look at it tomorrow and see if I can figure out what's going on.
Last edited by Elroy; Jun 30th, 2022 at 08:37 PM.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Apparently, our buffer (basically what MapViewOfFile) sets up is only "lazily" written out to far memory, even when that buffer is closed (via UnmapViewOfFile). Microsoft quote:
Modified pages in the unmapped view are not written to disk until their share count reaches zero, or in other words, until they are unmapped or trimmed from the working sets of all processes that share the pages. Even then, the modified pages are written "lazily" to disk; that is, modifications may be cached in memory and written to disk at a later time. To minimize the risk of data loss in the event of a power failure or a system crash, applications should explicitly flush modified pages using the FlushViewOfFile function.
... and I think it's fair to interpret "to disk" as "to Far Memory". So, apparently, part of the work is passed off to another thread handled by the OS.
-----
I'm working on putting in some FlushViewOfFile and maybe also FlushFileBuffers into the code to see how it runs then .. and I'll report back.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
I'm a bit lost, aren't these memory allocations intended to use just RAM memory? I don't want to use disk at all!
Or otherwise does it mean that I could have maps larger than the RAM memory size (because it would dump parts to disk)?
Well, I think that's just some language confusion. According to my reading of CreateFileMapping it's far memory, which may use the OS's virtual memory paging.
CreateFileMapping creates a file mapping object of a specified size that is backed by the system paging file instead of by a file in the file system.
If we push the dwMaximumSizeLow & dwMaximumSizeHigh too hard, it's almost certain to use virtual memory paging.
Also, I've got it working. Just give me a moment to post the changes (as an EDIT4) to the OP. I'll also post my test code for Form1 as a post below this one.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Also, I've got it working. Just give me a moment to post the changes (as an EDIT4) to the OP. I'll also post my test code for Form1 as a post below this one.
I'm making my own take, it will be (if I finish it) for variable length strings, but focusing on performance, I want it to be as fast as possible.
Ok, I've still got a problem. It's going to be a bit longer. Also, the way it's written (for speed), it's got an issue similar to sub-classing. If we use the IDE's stop button, the far memory file never gets closed, and just hangs around (even when in IDE design mode). Without severely hampering speed, I'm not sure there's a way to fix that one.
But I'm still running down another problem. I've got your initial problem fixed though.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Hmm, I'm about ready to throw all this stuff out the window.
I've got it to where it's working about 75% of the time. But if you repeatedly push it, it eventually crashes.
Here's my latest iteration of changes to that class (with some things highlighted):
Code:
' Ideas herein were inspired by some work that Dilettante (vbforums.com) had done.
'
' With this class, you can create an array that uses "far" memory,
' and isn't limited to the 2GB (or 4GB with LAA) that VB6 is limited to.
'
' Initialize must be called immediately after instantiation.
' Then, the Value property (Get & Let) can be used.
'
Option Explicit
'
Private Type SYSTEM_INFO
Reserved1(27&) As Byte
dwAllocationGranularity As Long ' For purposes herein, this is all we need.
Reserved2(3&) As Byte
End Type
'
Private Declare Function CreateFileMapping Lib "kernel32" Alias "CreateFileMappingA" (ByVal hFile As Long, ByVal lpFileMappigAttributes As Long, ByVal flProtect As Long, ByVal dwMaximumSizeHigh As Long, ByVal dwMaximumSizeLow As Long, ByVal lpName As String) As Long
Private Declare Function MapViewOfFile Lib "kernel32" (ByVal hFileMappingObject As Long, ByVal dwDesiredAccess As Long, ByVal dwFileOffsetHigh As Long, ByVal dwFileOffsetLow As Long, ByVal dwNumberOfBytesToMap As Long) As Long
Private Declare Function OpenFileMapping Lib "kernel32" Alias "OpenFileMappingA" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal lpName As String) As Long
Private Declare Function UnmapViewOfFile Lib "kernel32" (ByVal lpBaseAddress As Long) As Long
Private Declare Function FlushViewOfFile Lib "kernel32" (ByVal lpBaseAddress As Long, dwNumberOfBytesToFlush As Long) As Long
Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Long, ByRef Source As Long, ByVal Length As Long)
Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (ByRef Destination As Long, ByVal Length As Long)
Private Declare Sub GetSystemInfo Lib "kernel32" (ByRef lpSystemInfo As SYSTEM_INFO)
Private Declare Function VariantChangeType Lib "oleaut32" (Dest As Variant, src As Variant, ByVal wFlags As Integer, ByVal vt As Long) As Long
'
Private mbInit As Boolean
Private mbWritingDone As Boolean
Private mhMemFile As Long
Private miVarType As Long
Private miItemBytes As Long
Private mvMaxCount As Variant ' Decimal.
Private miVariantOffset As Long
Private miGranularity As Long
'
Private mpMapView As Long
Private mdwViewHigh As Long
Private mdwViewLow As Long
'
Public Sub Initialize(ByRef sUniqueName As String, iVarType As VBA.VbVarType, iMaxItemCount As Variant, Optional iFixedStringCharLen As Long = 10&, Optional bOpenOnlyNoCreate As Boolean = False)
'
' sUniqueName is a system-wide thing. If other programs are using CreateFileMapping,
' the sUniqueName must be unique with respect to those, and not only names used within this project.
'
' iVarType is simply the variable type you'll be storing in this array.
' Or, fixed length strings (not the same as VB6's fixed length strings) are allowed.
'
' iMaxItemCount is the maximum (not necessily used) number of items in the array.
' You will get an error if you overflow this when using the Value properties.
' Note that far memory is allocated based on this iMaxItemCount argument.
' This iMaxItemCount must be a numeric integer. It's not a Long so that even more than a Long's limits can be used.
'
' If iVarType = vbString then iFixedStringCharLen is examined for how long they should be.
' As a note, these strings CAN'T contain vbNullChar, as that's reserved for padding in these things.
'
If mbInit Then Exit Sub ' Only allow this to be called once.
If Not IsNumeric(iMaxItemCount) Then Err.Raise 13&, TypeName(Me), "iMaxItemCount must be numeric."
If iMaxItemCount < 1& Then Err.Raise 5&, TypeName(Me), "Count must be at least 1."
'
' Save granularity.
miGranularity = MemAllocGranularity
'
' The only allowed types are: vbBoolean, vbByte, vbCurrency, vbDate, vbDecimal, vbDouble, vbInteger, vbLong, vbSingle, or vbString.
Select Case iVarType
Case vbByte: miItemBytes = 1&: miVariantOffset = 8& ' These are the length (bytes) and offset with a variant for our data types.
Case vbBoolean, vbInteger: miItemBytes = 2&: miVariantOffset = 8& ' In most cases (all but Decimal), a variant stores data at an 8 byte offset.
Case vbLong, vbSingle: miItemBytes = 4&: miVariantOffset = 8&
Case vbCurrency, vbDate, vbDouble: miItemBytes = 8&: miVariantOffset = 8&
Case vbDecimal: miItemBytes = 14&: miVariantOffset = 2& ' This is the one case where all 14 bytes of the variant's data are used.
Case vbString
' This one needs a bit of special handling.
If miGranularity < iFixedStringCharLen Then Err.Raise 6&, TypeName(Me), "Fixed string length overflow. " & "Granularity: " & CStr(miGranularity) & " Length: " & CStr(iFixedStringCharLen)
If iFixedStringCharLen < 1& Then Err.Raise 6&, TypeName(Me), "Fixed string length underflow. Length: " & CStr(iFixedStringCharLen)
'
miItemBytes = iFixedStringCharLen * 2& ' Unicode.
miVariantOffset = 8& ' But, in this case, it's the BSTR pointer.
Case Else: Err.Raise 13&, TypeName(Me), "Invalid variable type specified."
End Select
'
' Save our initialization properties.
miVarType = iVarType
mvMaxCount = CDec(iMaxItemCount)
'
' Figure out byte size of Mapped File, and round UP to a multiple of MemAllocGranularity.
Dim vTotalBytes As Variant
vTotalBytes = CDec(miItemBytes) * mvMaxCount
vTotalBytes = Int((vTotalBytes - CDec(1&) + CDec(miGranularity)) / CDec(miGranularity)) * CDec(miGranularity)
'
' Copy low and high into MapViewOfFile offset arguments.
Dim dwMaximumSizeHigh As Long
Dim dwMaximumSizeLow As Long
'
' Variant structure with a Decimal.
' VariantType As Integer ' Reserved, to act as the Variant Type when sitting in a 16-Byte-Variant. Equals vbDecimal(14) when it's a Decimal type.
' Base10NegExp As Byte ' Base 10 exponent (0 to 28), moving decimal to right (smaller numbers) as this value goes higher. Top three bits are never used.
' sign As Byte ' Sign bit only. Other bits aren't used.
' Hi32 As Long ' Mantissa.
' Lo32 As Long ' Mantissa.
' Mid32 As Long ' Mantissa.
CopyMemory dwMaximumSizeHigh, ByVal PtrAdd(VarPtr(vTotalBytes), 12&), 4& ' Mid32
CopyMemory dwMaximumSizeLow, ByVal PtrAdd(VarPtr(vTotalBytes), 8&), 4& ' Lo32
'
' Create our memory file.
Const INVALID_HANDLE_VALUE As Long = -1&
Const PAGE_READWRITE As Long = 4&
Const FILE_MAP_WRITE As Long = 2&
Const FILE_MAP_READ As Long = 4&
'
If Not bOpenOnlyNoCreate Then
mhMemFile = CreateFileMapping(INVALID_HANDLE_VALUE, 0&, PAGE_READWRITE, dwMaximumSizeHigh, dwMaximumSizeLow, sUniqueName)
If mhMemFile = 0& Then
If Err.LastDllError = 1450& Then
Err.Raise Err.LastDllError, TypeName(Me), "CreateFileMapping error ERROR_NO_SYSTEM_RESOURCES. This probably means you don't have enough memory in this computer to map file(s) as large as you're trying to, or maybe memory is full with other executing programs."
Else
Err.Raise Err.LastDllError, TypeName(Me), "CreateFileMapping API system error."
End If
End If
'
Const ERROR_ALREADY_EXISTS As Long = 183&
If Err.LastDllError = ERROR_ALREADY_EXISTS Then CloseMemFile: Err.Raise 55&, TypeName(Me), sUniqueName & " already open."
Else
mhMemFile = OpenFileMapping(FILE_MAP_READ + FILE_MAP_WRITE, 0&, sUniqueName)
If mhMemFile = 0& Then Err.Raise Err.LastDllError, TypeName(Me), "OpenFileMapping API system error. Make sure the file exists."
End If
'
' All done and ready to be used.
mbInit = True
End Sub
Private Sub Class_Terminate()
' When all handles to the mapped object are closed, it disappears.
' When in the IDE, abnormal termination can leave the file open,
' and only way to get rid of it is to restart the IDE.
' When compiled, it's not a problem.
'
CloseMemFile
End Sub
Private Sub CloseMemFile()
If mpMapView Then
' Should be ApiZ and not Call. With Call, we're ignoring errors.
If mbWritingDone Then Call FlushViewOfFile(mpMapView, miGranularity)
ApiZ UnmapViewOfFile(mpMapView)
' Should be ApiZ and not Call. With Call, we're ignoring errors.
If mbWritingDone Then Call FlushFileBuffers(mhMemFile)
mpMapView = 0&
mbWritingDone = False
End If
If mhMemFile Then
ApiZ CloseHandle(mhMemFile)
mhMemFile = 0&
End If
End Sub
Public Property Let Value(index As Variant, vValue As Variant)
' Zero based index. It can be any numeric value, but will always be treated as an integer,
' and internally, it'll be handled as a Decimal.
'
' If you need an index larger than 2147483647 (&h7fffffff), you can cast a string to a decimal
' using something like: CDec("99999999999"), or just use Decimal types in the first place for your indices.
'
If Not mbInit Then Exit Property
'
' Make sure we've got valid arguments.
If VarType(vValue) <> miVarType Then CloseMemFile: Err.Raise 13&, TypeName(Me), "Value type doesn't match initialization type: " & TypeName(vValue)
Dim vDecIdx As Variant
vDecIdx = ValidateIndex(index)
'
' Create a map view of our memory file.
Dim iGranOffset As Long
iGranOffset = CreateSingleItemMapping(vDecIdx)
'
' Put data into memory mapped file.
If miVarType <> vbString Then
CopyMemory ByVal PtrAdd(mpMapView, iGranOffset), ByVal PtrAdd(VarPtr(vValue), miVariantOffset), miItemBytes
Else
ZeroMemory ByVal PtrAdd(mpMapView, iGranOffset), miItemBytes
Dim iChars As Long
iChars = miItemBytes \ 2&
Dim s As String
s = String$(iChars, vbNullChar) ' Create a buffer.
Mid$(s, 1&, Len(vValue)) = vValue ' s is now padded with vbNullChar if necessary.
CopyMemory ByVal PtrAdd(mpMapView, iGranOffset), ByVal StrPtr(s), miItemBytes ' We ignore the BSTR zero terminator.
End If
mbWritingDone = True
End Property
Public Property Get Value(index As Variant) As Variant
' Zero based index. See notes in "Let Value" property.
'
If Not mbInit Then Exit Property
'
' Make sure we've got valid arguments.
Dim vDecIdx As Variant
vDecIdx = ValidateIndex(index)
'
' Create a map view of our memory file.
Dim iGranOffset As Long
iGranOffset = CreateSingleItemMapping(vDecIdx)
'
' Get data from memory mapped file.
If miVarType <> vbString Then
Value = CLng(0&)
If miVarType <> vbLong Then ApiE VariantChangeType(Value, Value, 0&, miVarType) ' Make our variant the correct type.
CopyMemory ByVal PtrAdd(VarPtr(Value), miVariantOffset), ByVal PtrAdd(mpMapView, iGranOffset), miItemBytes
Else ' Handle strings.
Dim iChars As Long
iChars = miItemBytes \ 2&
Dim s As String
s = String$(iChars, vbNullChar) ' Create a buffer.
CopyMemory ByVal StrPtr(s), ByVal PtrAdd(mpMapView, iGranOffset), miItemBytes
' Now, trim to vbNullChar.
Dim i As Long
i = InStr(s, vbNullChar)
If i Then s = Left$(s, i - 1&)
Value = s
End If
End Property
Private Function ValidateIndex(index As Variant) As Variant ' vDecIdx is returned.
If Not IsNumeric(index) Then CloseMemFile: Err.Raise 9&, TypeName(Me), "Bad index type: " & TypeName(index)
Dim vDecIdx As Variant
vDecIdx = CDec(index)
If vDecIdx < 0& Or (vDecIdx + 1&) > mvMaxCount Then CloseMemFile: Err.Raise 9&, TypeName(Me), "Bad index range: " & CStr(vDecIdx)
If vDecIdx <> Int(vDecIdx) Then CloseMemFile: Err.Raise 9&, TypeName(Me), "Bad index value: " & CStr(vDecIdx)
'
ValidateIndex = vDecIdx
End Function
Private Function CreateSingleItemMapping(ByVal vDecIdx As Variant) As Long
' The iGranOffset is returned, which is an offset in the "View" to the specific item requested.
' mpMapView is also set.
'
' Convert vDecIdx into a byte offset.
vDecIdx = vDecIdx * CDec(miItemBytes)
'
' Calculate an offset that appreciates granularity.
Dim vTemp As Variant
vTemp = Int(vDecIdx / CDec(miGranularity)) ' Rounds down, preserving Decimal type.
vTemp = vTemp * CDec(miGranularity) ' This can now be used in MapViewOfFile API call.
CreateSingleItemMapping = vDecIdx - vTemp ' This provides an offset for addressing a single item.
'
' Copy low and high into MapViewOfFile offset arguments.
Dim dwFileOffsetHigh As Long
Dim dwFileOffsetLow As Long
'
' Variant structure with a Decimal.
' VariantType As Integer ' Reserved, to act as the Variant Type when sitting in a 16-Byte-Variant. Equals vbDecimal(14) when it's a Decimal type.
' Base10NegExp As Byte ' Base 10 exponent (0 to 28), moving decimal to right (smaller numbers) as this value goes higher. Top three bits are never used.
' sign As Byte ' Sign bit only. Other bits aren't used.
' Hi32 As Long ' Mantissa.
' Lo32 As Long ' Mantissa.
' Mid32 As Long ' Mantissa.
CopyMemory dwFileOffsetHigh, ByVal PtrAdd(VarPtr(vTemp), 12&), 4& ' Mid32
CopyMemory dwFileOffsetLow, ByVal PtrAdd(VarPtr(vTemp), 8&), 4& ' Lo32
'
' Make sure we need to do something.
If mpMapView = 0& Or mdwViewHigh <> dwFileOffsetHigh Or mdwViewLow <> dwFileOffsetLow Then
If mpMapView Then
' Should be ApiZ and not Call. With Call, we're ignoring errors.
If mbWritingDone Then Call FlushViewOfFile(mpMapView, miGranularity)
ApiZ UnmapViewOfFile(mpMapView)
' Should be ApiZ and not Call. With Call, we're ignoring errors.
If mbWritingDone Then Call FlushFileBuffers(mhMemFile)
mbWritingDone = False
End If
mdwViewHigh = 0&
mdwViewLow = 0&
'
' Create a mapview of our memory file.
Const FILE_MAP_WRITE = 2&
Const FILE_MAP_READ = 4&
'Debug.Print "M";
mpMapView = MapViewOfFile(mhMemFile, FILE_MAP_READ + FILE_MAP_WRITE, dwFileOffsetHigh, dwFileOffsetLow, miGranularity)
If mpMapView = 0& Then CloseMemFile: Err.Raise Err.LastDllError, TypeName(Me), "MapViewOfFile system error."
'
mdwViewHigh = dwFileOffsetHigh
mdwViewLow = dwFileOffsetLow
End If
End Function
Private Function MemAllocGranularity() As Long
' When using MapViewOfFile, the quad_word offset must be a multiple of this granularity (per MSDN).
Dim si As SYSTEM_INFO
GetSystemInfo si
MemAllocGranularity = si.dwAllocationGranularity
End Function
Private Function PtrAdd(ByVal Ptr As Long, ByVal iOffset As Long) As Long
' For adding (or subtracting) a small number from a pointer.
PtrAdd = (Ptr Xor &H80000000) + iOffset Xor &H80000000
End Function
Private Function ApiZ(ApiReturn As Long, Optional sApiCall As String) As Long
' This one is for API calls that report error by returning ZERO.
'
If ApiReturn <> 0& Then
ApiZ = ApiReturn
Exit Function
End If
'
Dim sErr As String
If Len(sApiCall) Then
sErr = sApiCall & " error " & CStr(Err.LastDllError)
Else
sErr = "API Error " & CStr(Err.LastDllError)
End If
'
Dim InIDE As Boolean: Debug.Assert MakeTrue(InIDE)
If InIDE Then
Debug.Print sErr
Stop
Else
Err.Raise vbObjectError + 1147221504, , sErr
End If
End Function
Private Sub ApiE(ApiReturn As Long, Optional sApiCall As String)
' Just a general error processing procedure for API errors.
' For API calls where 0& is OK.
'
If ApiReturn = 0& Then Exit Sub
'
Dim sErr As String
If Len(sApiCall) Then
sErr = sApiCall & " error " & CStr(ApiReturn)
Else
sErr = "API Error " & CStr(ApiReturn)
End If
'
Dim InIDE As Boolean: Debug.Assert MakeTrue(InIDE)
If InIDE Then
Debug.Print sErr
Stop
Else
Err.Raise vbObjectError + 1147221504 - ApiReturn, , sErr
End If
End Sub
Private Function MakeTrue(ByRef b As Boolean) As Boolean
b = True
MakeTrue = True
End Function
And here's the latest "test" code (for Form1) I was using:
Code:
Option Explicit
'
Dim oStr As MemoryBasedArray
Private Sub Form_Load()
Stop
Set oStr = New MemoryBasedArray
oStr.Initialize "StrTest2", vbString, 700000, 300&
'
oStr.Value(0&) = "aaaa"
oStr.Value(1&) = "bbbbbbbbbbbb" ' Too long so it'll be truncated.
oStr.Value(2&) = vbNullString
oStr.Value(300000) = "dddddddd"
'
Debug.Print "'"; oStr.Value(0&); "'"
Debug.Print "'"; oStr.Value(1&); "'"
Debug.Print "'"; oStr.Value(2&); "'"
Debug.Print "'"; oStr.Value(3&); "'"
Debug.Print "'"; oStr.Value(4&); "'"
Stop
Dim c As Long
Dim s As String
For c = 10 To 500000
oStr.Value(c) = CStr(c)
s = oStr.Value(c)
If s <> CStr(c) Then Debug.Print "bad put/get": Stop
'If c Mod 1000 = 0 Then Stop
Next
Stop
Unload Me
End Sub
I'm ignoring errors on calls to both FlushViewOfFile and FlushFileBuffers, because they're both erroring when they shouldn't. It seems that FlushFileBuffers is failing only when FlushViewOfFile fails, but I'm not absolutely positive about that.
I've found one webpage that suggests this stuff is buggy.
I'm gonna set it down for a while, maybe taking another run at it later.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
If you can live within our 2GB limits, I certainly wouldn't advise using this far memory stuff.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Calls to that FlushViewOfFile API keep failing (not always, but just sometimes).
And, after enough fail, it crashes the program.
I've searched and I can't find any reasonable fixes. I'll tackle it again later, but I'm giving it a break right now.
Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.
Reply With Quote
Originally Posted by Eduardo-
