OK before I post my actual problem I'd just like to say the problem involves a dynamic array of a typed variable, where the typed variable contains three VB collections. Please
please don't advise me to make the dynamic array itself a collection. Its done that way for several excellent reasons
I've written a powerful low level editor for altering data files and save games used by the Bethesda game TES3 Morrowind. The generic file structure is effectively a collection of collections of collections, which was reflected in my initial efforts. However, over a certain threshold of members VB collection disposal gets
horribly slow, even if you iterate backwards through the members disposing of them individually, so I settled on a dynamic array of collections of collections, which has worked nicely to date.
I've worked for 6 months on this thing and that structure is so widely coded for there's no way I'm even going to consider changing the meta-structure.
The problem is this: each top level structure in the dynamic array (a "record") can have its data in a "packed" (byte array) form or an "unpacked" (collection of objects with collections) form. The packed form is effectively the serialised form of the object collection for a given element of the array. I've written code to
a) Unpack the record data into a collection, redimming the byte array to zero.
b) Pack the data back up into a byte array, disposing of the collection.
However, despite explicity removing all of the members of the collection and setting the collection itself to nothing, the memory occupied by the collection is not disposed of. I picked this up after implementing a memory monitor in the program that dynamically reports free memory. Also when debugging in VB, whole chunks of memory get grabbed and not released each time I run, until I shut down the IDE.
I've gone through the thing with a fine tooth comb, checking for circular references and all the other usual suspects, but I can't find a solution.
Eventually I pulled down some reference counting code and put little messageboxes everywhere. What I could determine is that when my unpacking procedure, that unpacks the byte array into a collection of objects ("de-serialises" the byte data), exits, each member of the collection has a reference count of two, for no apparent reason. I don't know if this is accurate though because MSDN says a nonzero reference count is not necessarily the number of references to an object because of complex shortcuts in the logic. Anyway, here is the unpacking code that ostensibly products two references to each item in the collection:
Code:
Dim currByte As Long
Dim SRec1 As esSubRecord
Dim SRec2 As esSubRecord
Dim fmtEntry As String
Dim ind As Long
Dim GroupCount As Long
Dim GroupType As String
Dim GroupEntry As Variable
Dim srType As String
Dim rtype As String
Dim strID As String
GroupCount = intZero
GroupType = vbNullString
ind = GetRecordIndex(RecIndex)
'already unpacked
If Not mvarRecords(ind).Packed Then Exit Sub
sRecNumber = intZero
With mvarRecords(ind)
ReDim .GroupID(intZero)
Set .subrecords = New esTypeLibrary.esSubRecords
currByte = intZero
While currByte < .Size
Set SRec1 = ReadSubRecord(ind, currByte)
'Attempt to add first without number appended
'so that the first sub record of a particular type (e.g. NAME)
'in the Record is referenced by subrecord type, rather than, say "NAME14232"
'Saves hassle in ID logic in GETID
If .subrecords.Exists(SRec1.SubrecordType) Then
Set SRec2 = .subrecords.Add(SRec1.SubrecordType & sRecNumber)
Else
Set SRec2 = .subrecords.Add(SRec1.SubrecordType)
End If
SRec2.Offset = SRec1.Offset
SRec2.Size = SRec1.Size
SRec2.SubrecordType = UCase$(SRec1.SubrecordType)
Set SRec2.esProperties = Nothing
SRec2.Data = SRec1.Data
Set SRec1 = Nothing
srType = SRec2.SubrecordType
rtype = mvarRecords(ind).Category
'Special case for 12-byte NPCs (Different record structure - odd...)
If srType = strNPDT And SRec2.Size = int12 And (rtype = strNPC_) Then
srType = strNPDT_12
Else
'Special case for second and subsequent data subrecs in CELL record
'First is cell grid pos, subsequent are internal object pos and rot
If srType = strDATA And SRec2.Size = int24 And (rtype = strCELL) Then
srType = strDATA_24
Else
'Special case for second and subsequent NAME subrecs in CELL record
'First is cell Name, subsequent are internal object Names
'Work out by offset since first name entry is always first in the
'record
If (srType = strNAME) And (SRec2.Offset <> 0) And (rtype = strCELL) Then
srType = strNAME_NEXT
End If
End If
End If
'Change the subrecord Type
SRec2.SubrecordType = srType
fmtEntry = rtype & strFullStop & srType
If cfgFormat.GroupExists(fmtEntry) Then
'Check for Group Start
If cfgFormat.InstrExists(fmtEntry, strStartGroup) Then
Set GroupEntry = cfgFormat.Groups(fmtEntry).Instructions(strStartGroup)
If UCase$(GroupEntry.Value1) = strMainRecord Then 'Part of the Main Record
SRec2.GroupType = vbNullString
SRec2.GroupNumber = 0
strID = vbNullString
Else
GroupCount = GroupCount + intOne
ReDim Preserve .GroupID(GroupCount)
GroupType = GroupEntry.Value1
SRec2.GroupType = GroupType
SRec2.GroupNumber = GroupCount
.MaxGroupNumber = GroupCount
'This logic scrapped for speed - no group ID's
'see below too
'Now get the ID field
'If cfgFormat.InstrExists(fmtEntry, strIDProp) Then
' strID = cfgFormat.Groups(fmtEntry).Instructions(strIDProp)
'Else
' strID = vbNullString
'End If
End If
Else
SRec2.GroupNumber = GroupCount
SRec2.GroupType = GroupType
End If
'This logic scrapped for speed - no group ID's
'see above too
'Check for Requirement Level
'0 = Not Required
'1 = Required for Group (Such as the group of variables referring to one item in a cell)
'2 = Required for Record
If cfgFormat.InstrExists(fmtEntry, strRequired) Then
Set GroupEntry = cfgFormat.Groups(fmtEntry).Instructions(strRequired)
SRec2.RequirementLevel = Val(GroupEntry.Value)
Else
'If this is an ID subrecord, the requirement level is still 2
SRec2.RequirementLevel = intZero
End If
Else
SRec2.RequirementLevel = intZero
SRec2.GroupNumber = GroupCount
SRec2.GroupType = GroupType
End If
sRecNumber = sRecNumber + intOne
currByte = currByte + SRec2.Size + intsrHeaderSize
Set SRec2 = Nothing
Wend
If Not KeepRawData Then
ReDim .Data(intZero)
.Packed = False
End If
End With
Set GroupEntry = Nothing
Set SRec1 = Nothing
Set SRec2 = Nothing
Problems with an array of collections
Linear Mode
