Vintage VB6 structured-key Dictionary class

XenoEngineer

Using claude.ai Haiku 3 for nostaligic VB6 coding cleanup and commenting through Msty Studio.  00:55, 1 June 2024 (UTC)

The dim glow of a CRT monitor illuminates the cramped office, casting a warm, nostalgic light on the cluttered desk. Stacks of floppy disks and dog-eared programming manuals jostle for space, a testament to the developer's unwavering dedication. The air is thick with the scent of freshly brewed coffee and the faint whirring of a cooling fan.

Hunched over the keyboard, the developer's fingers fly across the keys, their movements practiced and precise. The classic Visual Basic 6 IDE blinks to life, its iconic interface a familiar sight. Intricate lines of code cascade across the screen, each one a carefully crafted piece of the puzzle.

The developer's face is set with intense concentration, brow furrowed as they navigate the complexities of the clsStrucKeys class. This is their domain, a world of structured data and seamless integration, where their mastery of VB6 shines like a beacon in the digital landscape.

The office is a time capsule, a sanctuary where the dot-com era lives on. Posters of bygone tech giants and motivational slogans adorn the walls, reminders of a bygone era when the digital revolution was just beginning to take shape.

Through the window, the hazy glow of cityscape illuminates the night, a backdrop to the developer's focused work. It is in this moment, surrounded by the trappings of a bygone era, that the true power and elegance of the clsStrucKeys class emerges, a testament to the developer's skill and the enduring spirit of the dot-com era.

''      Module name:    clsStrucKeys
''      Author:         XenoEngineer@groupKOS.com
''      Created:        2024.05.28
''
''  This class provides functionality for managing structured key-value (SKV) data
''  stored in files. It supports configuring the class properties, saving and loading
''  SKV data to/from shadow files, and performing various operations on the SKV data,
''  such as adding, removing, and searching.
''
''  The class uses a Dictionary object to store the SKV data, and provides methods
''  for serializing and deserializing the data to and from a string format.
''
''  The class also includes file utility methods to build the paths for configuration,
''  shadow, and message files based on the configured properties.
''
''  The `msg` dictionary is used to store process messages, such as errors, exceptions,
''  and other informational messages. These messages can be accessed from the calling
''  code after the `Show vbModal` statement.
''
''  The structured keys in the `skv` dictionary serve as an in-memory data model that
''  is automatically shadowed to a file. The calling code is responsible for providing
''  any default values for the structured keys.
''
''  The class can be configured to automatically save the SKV data on every change, or
''  the calling code can manually call the `save()` method to persist the changes.
''
''  The structure of the keys in the `skv` dictionary uses a delimiter to represent a
''  hierarchical, DOM-like path. This allows for efficient querying and retrieval of
''  data using the `partialMatches()` method.
''
''  The `skv` dictionary is not instantiated within the class itself, but rather passed
''  in from the calling code. This enables the flexibility of having multiple instances
''  of the `clsStrucKeys` class reference the same `skv` dictionary, which can then be
''  shared across multiple forms or APIs.

Option Explicit

'' Events raised by the class
Public Event Configured(structureName As String, dskvCount As Long)
Public Event Loaded(structureName As String, dskvCount As Long)
Public Event Saved(structureName As String, dskvCount As Long)
Public Event StructureAdded(key As String)
Public Event StructureChanged(key As String)
Public Event StructureRemoved(key As String)

'' Module-level properties
Private Type udtModuleProperties
    engineerID      As String        '' The unique identifier for the engineer or user
    structureName   As String        '' The name of the structured data
    shadowFolderName    As String    '' The folder name for the shadow files
    
    msg             As Dictionary    '' Dictionary to store error, exception, and other process messages
    cfg             As Dictionary    '' Dictionary to store configuration settings
    skv             As Dictionary    '' Dictionary to store the structured key-value data
    
    pairDelim       As String        '' The delimiter used to separate key-value pairs
    listDelim       As String        '' The delimiter used to separate list items
    strucKeyDelim   As String        '' The delimiter used to separate structured keys
    
    shadowExt       As String        '' The file extension for shadow files
    configExt       As String        '' The file extension for configuration files
    msgExt          As String        '' The file extension for message files
End Type

Private m           As udtModuleProperties

'' Initialize the class instance
Private Sub Class_Initialize()
    '' Intentionally left empty
End Sub

'' Terminate the class instance and sever the SKV class instance reference
Private Sub Class_Terminate()
    Set m.skv.a = Nothing
End Sub

'' Configure the class properties based on the provided parameters
Public Function configure( _
                           engineerID As String, _
                           structureName As String, _
                           shadowFolderName As String, _
                           Optional msgExt As String = "", _
                           Optional configExt As String = "", _
                           Optional shadowExt As String = "", _
                           Optional strucKeyDelimiter As String = "", _
                           Optional listDelimiter As String = "", _
                           Optional pairDelimiter As String = "" _
                         ) As Boolean
    With m
        '' Set the required properties
        .engineerID = engineerID
        .structureName = structureName
        .shadowFolderName = shadowFolderName
        
        '' Set the default optional configuration properties
        .pairDelim = PAIR_DELIMITER
        .listDelim = LIST_DELIMITER
        .strucKeyDelim = STRUCKEY_DELIMITER
        .shadowExt = SHADOW_FILE_EXT
        .configExt = CONFIG_FILE_EXT
        .msgExt = MESSGE_FILE_EXT
        
        '' Update the properties from the method parameters, if provided
        If Len(msgExt) > 0 Then .msgExt = msgExt
        If Len(configExt) > 0 Then .configExt = configExt
        If Len(shadowExt) > 0 Then .shadowExt = shadowExt
        If Len(strucKeyDelimiter) > 0 Then .strucKeyDelim = strucKeyDelimiter
        If Len(pairDelimiter) > 0 Then .pairDelim = pairDelimiter
        If Len(listDelimiter) > 0 Then .listDelim = listDelimiter
    End With
    
    RaiseEvent Configured(m.structureName, m.skv.Count)
    configure = True
End Function

'' The `item` property is the default property for the class, allowing
'' you to use the dictionary-like syntax to access and modify the
'' structured key-value data:
''
'' skv("Users.ID.email") = email
'' email = skv("Users.ID.email")
Public Property Get item() As Dictionary: On Error Resume Next
    Set item = m.skv
End Property
Public Property Set item(oDict As Dictionary): On Error Resume Next
    Set m.skv = oDict
End Property

'' The `msg` property provides access to the dictionary that stores
'' process messages, such as errors, exceptions, and other informational
'' messages. These messages can be accessed from the calling code after
'' the `Show vbModal` statement.
Public Property Get msg() As Dictionary: On Error Resume Next
    Set msg = m.msg
End Property
Public Property Set msg(oMsg As Dictionary): On Error Resume Next
    Set m.msg = oMsg
End Property

'' The `cfg` property provides access to the dictionary that stores
'' configuration settings for the class.
Public Property Get cfg() As Dictionary: On Error Resume Next
    Set cfg = m.cfg
End Property
Public Property Set cfg(oCfg As Dictionary): On Error Resume Next
    Set m.cfg = oCfg
End Property

'' The `skv` property provides access to the dictionary that stores
'' the structured key-value data. This is the in-memory data model
'' that is automatically shadowed to a file.
Public Property Get skv() As Dictionary: On Error Resume Next
    Set skv = m.skv
End Property
Public Property Set skv(oskv As Dictionary): On Error Resume Next
    Set m.skv = oskv
End Property

'' Save the structured-keyed-values (m.skv) to the shadow file
Public Function save() As Boolean
    On Error Resume Next
    
    If fileWrite(filePath:=shadowFilespec(), _
                 content:=dict2DSKVList(m.skv)) Then
        
        save = Not Err
        addMsg "save(OK): filePath=" + shadowFilespec
    Else
        addMsg "skvSave.fileWrite(FAILURE): " + shadowFilespec + " .. " + formatErr(Err)
        On Error GoTo 0
    End If
    
    RaiseEvent Saved(m.structureName, m.skv.Count)
End Function

'' Load the structured-keyed-values (m.skv) from the shadow file
Public Function load(structureName As String, dataFolder As String) As Boolean
    On Error Resume Next
    
    With m
        If Me.deserialize(fileRead(shadowFilespec), _
                          .pairDelim, _
                          .listDelim) Then
            addMsg " load(" + m.structureName + ")=OK: Properties set. SKV folder=" + shadowFilespec
        End If
    End With
    
    '' Deserialize the structured keyed-values (SKV) list from file to an SKV Dictionary
    If Me.deserialize(dskvList:=configFilespec) Then
        addMsg "configure.deserialize(OK): Set dskvList"
        load = Not Err
    Else
        addMsg "configure.deserialize(FAILURE): " + formatErr(Err)
        On Error GoTo 0
    End If
    
    RaiseEvent Loaded(m.structureName, m.skv.Count)
End Function

Public Property Get CompareMode() As Long: CompareMode = m.skv.CompareMode: End Property
Public Property Let CompareMode(mode As Long): m.skv.CompareMode = mode: End Property

Public Function add(key As String, item As Variant) As Boolean
    On Error Resume Next
    
    m.skv.add LCase(Trim(key)), item
    add = Not Err
    RaiseEvent StructureAdded(key)
End Function

Public Function remove(key As String) As Boolean
    m.skv.remove LCase(Trim(key))
    RaiseEvent StructureRemoved(key)
End Function

Public Property Get keys() As String(): keys = m.skv.keys: End Property

Public Property Get Count() As Long
    On Error Resume Next
    Count = m.skv.Count
End Property

'' Search for keys that partially match the provided string
Public Function matches(partialKey As String) As Dictionary
    Dim k As Variant
    Dim matchs As New Dictionary
    
    On Error Resume Next
    
    For Each k In m.skv.keys
        If InStr(1, LCase(Trim(k)), LCase(Trim(partialKey)), vbTextCompare) > 0 Then
            matchs.add k, m.skv(k)
        End If
    Next
    
    Set matches = matches
End Function

'' Search for keys that partially match the provided string and
'' satisfy the specified comparison condition
Public Function matchesWhere(partialKey As String, compareValue As Variant, operator As String) As Dictionary
    Dim matches As New Dictionary
    Dim keyValue As Variant
    Dim conditionMet As Boolean
    Dim k As Variant
            
    For Each k In m.skv.keys
        If InStr(1, LCase(Trim(k)), LCase(Trim(partialKey)), vbTextCompare) > 0 Then
            keyValue = m.skv(k)
            
            Select Case operator
                Case "=": conditionMet = (keyValue = compareValue)
                Case ">": conditionMet = (keyValue > compareValue)
                Case "<": conditionMet = (keyValue < compareValue)
                Case ">=": conditionMet = (keyValue >= compareValue)
                Case "<=": conditionMet = (keyValue <= compareValue)
                Case Else
                    m.msg.add CStr(m.msg.Count + 1), "matchesWhere(Invalid operator): " & operator + "Use '=, >, <, >=, <='"
            End Select
            
            If conditionMet Then
                matches.add k, keyValue
            End If
        End If
    Next
    
    Set matchesWhere = matches
End Function

Public Function deserialize(dskvList As String, _
                            Optional pairDelim = "=", _
                            Optional listDelim = vbCrLf _
                            ) As Boolean
    Dim i As Long
    Dim lst() As String
    Dim kv() As String
    
    On Error GoTo trap
    
    If Len(pairDelim) > 0 Then m.pairDelim = pairDelim
    If Len(listDelim) > 0 Then m.listDelim = listDelim
    
    lst = Split(dskvList, listDelim)
    
    '' Loop and split structured-keys from values, and load into a Dictionary by key
    For i = 0 To UBound(lst)
        kv = Split(lst(i), pairDelim)
        m.skv(kv(0)) = kv(1)
    Next
    
    If Not Err Then
        deserialize = True
        addMsg "deserialize(OK): " + CStr(m.skv.Count) + " structured key-value pairs loaded."
    Else
        addMsg "deserialize(FAILED): " + CStr(m.skv.Count)
    End If
    
    On Error GoTo 0
    Exit Function
trap:
    Select Case Err.Number
        Case 1
            MsgBox CStr(Err.Number) + ": " + Err.Description
        Case Else
            MsgBox CStr(Err.Number) + ": " + Err.Description
            Resume
    End Select
End Function

Public Function serialize(Optional pairDelim As String = "", _
                          Optional listDelim As String = "" _
                          ) As String
    Dim key As Variant
    Dim pub() As String
    Dim i As Long
    Dim maxWide As Long
    
    If Len(pairDelim) = 0 Then pairDelim = m.pairDelim
    If Len(listDelim) = 0 Then listDelim = m.listDelim
    
    ReDim pub(1 To m.skv.Count)
    
    i = 1
    '' Read through the keys to find the widest for formating
    For Each key In m.skv.keys
        If Len(key) > maxWide Then maxWide = Len(key)
        i = i + 1
    Next
    
    i = 1
    '' Serialize formatted keys/values
    For Each key In m.skv.keys
        pub(i) = key + Space(2 + maxWide - Len(key)) + m.skv(key)
        i = i + 1
    Next
    
    serialize = Join(pub, listDelim)
End Function

'' Private scope notation macros --repeated in each module needed
Public Sub addMsg(msg As String): On Error Resume Next
    m.msg(CStr(m.msg.Count + 1)) = msg
End Sub

Private Function formatErr(er As ErrObject) As String
    formatErr = "Err(" + CStr(er.Number) + "): " + er.Description + "  " + er.Source
End Function

'' File utility methods
Public Function buildConfigPath(parentFolder As String) As String
    buildConfigPath = parentFolder + "\" + m.structureName + "." + m.configExt
End Function

Public Function buildShadowFileSpec(parentFolder As String) As String
    buildShadowFileSpec = parentFolder + "\" + m.shadowFolderName
End Function

Public Function buildMsgFileSpeck(parentFolder As String) As String
    buildMsgFileSpeck = parentFolder + "\" + m.structureName + "." + m.msgExt
End Function

Public Property Get shadowFilespec() As String
    shadowFilespec = m.shadowFolderName + "\" + m.engineerID + "\" + m.structureName + "." + m.shadowExt
End Property

Public Property Get configFilespec() As String
    configFilespec = App.Path + "\config\" + m.engineerID + "\" + m.structureName + "." + m.configExt
End Property

Public Property Get msgFilespec() As String
    msgFilespec = App.Path + "\config\" + m.engineerID + "\" + m.structureName + "." + m.msgExt
End Property