View source for XenotoolsVB6 SKV Array Class

{{menuXenotoolsVB6}}
<pre style="background-color:cornsilk;">
''  clsOptions  --user-options in serializable object-hierarchy
''
''  Load calls Deserialize
''  Save calls Serialize
''
''  load(optional skvFile as string="" ) as boolean
''  deserialize(skvOptions as string="" ) as boolean
''
''  save(optional file as string="" ) as boolean
''  serialize() as string
''
</pre>

== Declarations header ==
<pre style="background-color: lightpink;">
Option Explicit

Public Event initialized(class as string )
Public Event Loaded(file As String)
Public Event Saved(file As String)
Public Event Deserialized()
Public Event Serialized()

    
Private Const CLASS_NAME = "Options"

Private Enum enumStati
    initialized = 1
    loaded
    saved
End Enum

Private Type udtBehavior
    loadOnInitialize    As Boolean
    saveOnTerminate     As Boolean
End Type

Private Type udtSKV
    className           As String
    parentNamePath      As String
    rootNamePath        As String
    
    SKV()               As String
    skvCount            As Long
    skvAllocInitial     As Long
    skvAllocAdditional  As Long
    skvFile             As String       ''  Storing a binary shadow of this class's contents. Hard coded in Initialize.
    
    status              As enumStati
    file                As String   
End Type

Private m As udtSKV
</pre>


<pre style="background-color: lavenderpink;">
Private Sub Class_Initialize()    
    ''  Set all property initialization values
    m.skvFile = app.path + "\" + app.EXEName + ".options.skv"    
    m.className = CLASS_NAME    
End Sub

Public Function initialize(parentNamePath As String, _
                           Optional cmndsDoc As String = "") As Boolean
    Dim f As New clsFile
    
    With m
        .className = CLASS_NAME
        .parentNamePath = parentNamePath
        .rootNamePath = parentNamePath + SKV_DELIM_PATH + .className
        
        .skvFile = app.path + "\" + app.EXEName + ".options.skv"
        
        .skvFile .skvFile
    End With
    
    ReDim m.SKV(1 To 1024) As String
        
    
    Const delimKey = "."
    Const delimElements = "="
    Const delimPair = delimElements
    Const delimValues = ","
    Const delimList = vbCrLf
    Const allocChunk = 2 ^ 10
    
    On Error GoTo trap
    
    Select Case False 'drop-out from chain of truths
    
        Case Len(dataFolder) > 0
            errRaise "Empty 'dataFolder' parameter passed to initialize"
            Exit Function
        
        Case f.FolderExists(dataFolder)
            
    End Select
    
    With m
        .dataFolder = app.path + "\data"
        
        .configFile = .dataFolder + ".cfg"
        .dataFolderOK = folderCheck(.agencyDataFolder)
        .processName = CLASS_NAME
        
        .msgLogAllocChunk = 2 ^ 10
        .msgLogDelimElements = ":"
        .msgLogDelimList = vbCrLf
        .msgLogDelimNamePath = "."
        .msgLogFile = app.path + "\" + app.EXEName + ".log"
        
        .optionsFile = .optionsFile + "\" + app.EXEName + ".opt"
        
        
        .agencyTitle = app.title
        .agencyRoot = "root"
    End With
    
    With m
        .msgLogAllocChunk = allocChunk
        .msgLogDelimElements = ""
        .msgLogDelimNamePath = "."
    End With
    
    With m
        .xNodeDelimKey = XNODE_ROOT_PATH_DELIM
    End With
    
    With m
'        .cmdArgKeyDelim = CMD_DELIM_ARG_PAIR
'        .cmdArgPairDelim = CMD_DELIM_ARG_PAIR
'        .cmdArgsDelim = CMD_DELIM_ARGS
'        .cmdsAllocChunk = CMDS_ALLOC_CHUNK
'        .cmdsDelim = CMDS_DELIM_LIST
    End With
    
    With m
        .selEndpointID = DEF_SELECT_ENDPOINTID
        .selEngineerID = DEF_SELECT_ENGINEERID
        .selPromptID = DEF_SELECT_PROMPTID
        .selQueryID = DEF_SELECT_QUERYID
        .selResponseID = DEF_SELECT_RESPONSEID
    End With
    
    With m
        .skvAllocChunk = SKV_ALLOC_CHUNK
        .skvDelimKey = SKV_DELIM_KEY
        .skvDelimList = SKV_DELIM_LIST
        .skvDelimPair = SKV_DELIM_PAIR
        .skvDelimValues = SKV_DELIM_VALUES
    End With
            
    With m
        '' Deserialized in alphabetic order --Serialized in the same alphabetic order ''
        .agencyConfigFile = config(i): i = i + 1
        .agencyMsgLogFile = config(i): i = i + 1
        .agencyTitle = config(i): i = i + 1
        .agencyRoot = config(i): i = i + 1
        
        .cmdArgPairDelim = config(i): i = i + 1
        .cmdArgsDelim = config(i): i = i + 1
        .cmdsAllocChunk = config(i): i = i + 1
        .cmdsDelim = config(i): i = i + 1
        
        .selFileConfig = config(i): i = i + 1
        .selEndpointID = config(i): i = i + 1
        .selEngineerID = config(i): i = i + 1
        .selPromptID = config(i): i = i + 1
        .selQueryID = config(i): i = i + 1
        .selResponseID = config(i): i = i + 1
        
        .skvAllocChunk = config(i): i = i + 1
        .skvDelimKey = config(i): i = i + 1
        .skvDelimList = config(i): i = i + 1
        .skvDelimPair = config(i): i = i + 1
        .skvDelimValues = config(i): i = i + 1
        
        .msgLogDelimElements = config(i): i = i + 1
        .msgLogDelimNamePath = config(i): i = i + 1
        .msgLogAllocChunk = config(i): i = i + 1
        .msgLogDelimList = config(i): i = i + 1
        
        .xNodeDelimKey = config(i): i = i + 1
        
        .status = initInitialized
    End With
    
    initialize = True
    
    Exit Function
trap:
    Select Case err.Number
        Case Else
            err.Raise errFormat
    End Select
End Function

Private Sub Class_Terminate()
    
    On Error Resume Next
    
    With New clsFile
        '.save (m.processParentPath)
    End With
End Sub
</pre>

<pre style="background-color:aliceblue;">
Public Function folderCheck(FolderPath As String, createIfMissing As Boolean) As Boolean
    On Error GoTo trap
    
    If FolderExists(FolderPath) Then
        folderCheck = True
    Else
        If createIfMissing Then MkDir FolderPath
        If FolderExists(FolderPath) Then
            folderCheck = True
        End If
    End If
    
trap:
End Function
</pre>


'''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''' Cmds '''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''

<pre style="background-color:#eee;">
Public Property Get cmdArgPairDelim() As String:    cmdArgPairDelim = m.cmdArgPairDelim: End Property
Public Property Let cmdArgPairDelim(value As String):    m.cmdArgPairDelim = value: End Property

Public Property Get cmdArgsDelim() As String:    cmdArgsDelim = m.cmdArgsDelim: End Property
Public Property Let cmdArgsDelim(value As String):    m.cmdArgsDelim = value: End Property

Public Property Get cmdsAllocChunk() As Long:    cmdsAllocChunk = m.cmdsAllocChunk: End Property
Public Property Let cmdsAllocChunk(value As Long):    m.cmdsAllocChunk = value: End Property

Public Property Get cmdsDelimList() As String:    cmdsDelimList = m.cmdsDelim: End Property
Public Property Let cmdsDelimList(value As String): m.cmdsDelim = value: End Property


'''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''' SKV '''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Property Get skvAllocAdditional() As Long:    skvAllocAdditional = m.skvAllocAdditional: End Property
Public Property Let skvAllocAdditional(value As Long):    m.skvAllocAdditional= value: End Property

Public Property Get skvAllocInitial() As Long:    skvAllocInitial = m.skvAllocInitial: End Property
Public Property Let skvAllocInitial(value As Long):    m.skvAllocInitial = value: End Property
    
Public Property Get skvDelimKey() As String:    key = m.skvDelimKey: End Property
Public Property Let skvDelimKey(value As String):    m.skvDelimKey = value: End Property

Public Property Get skvDelimDoc() As String:    skvDelimDoc= m.skvDelimDoc: End Property
Public Property Let skvDelimDoc(value As String):    m.skvDelimDoc= value: End Property

Public Property Get skvDelimList() As String:    skvDelimList = m.skvDelimList: End Property
Public Property Let skvDelimList(value As String):    m.skvDelimList = value: End Property

Public Property Get skvDelimPair() As String:    skvDelimPair = m.skvDelimPair: End Property
Public Property Let skvDelimPair(value As String):    m.skvDelimPair = value: End Property

Public Property Get skvDelimValues() As String:    skvDelimValues = m.skvDelimValues: End Property
Public Property Let skvDelimValues(value As String):    m.skvDelimValues = value: End Property


'''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''  NamePath msg log  ''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Property Get msgLogAllocChunk() As Long:    msgLogAllocChunk = m.msgLogAllocChunk: End Property
Public Property Let msgLogAllocChunk(value As Long):    m.msgLogAllocChunk = value: End Property

''  elements = epoch, ParentPath, message
Public Property Get msgLogDelimElements() As String:    msgLogDelimElements = m.msgLogDelimElements: End Property
Public Property Let msgLogDelimElements(value As String):    m.msgLogDelimElements = value: End Property

Public Property Get msgLogDelimList() As String:    msgLogDelimList = m.msgLogDelimList: End Property
Public Property Let msgLogDelimList(value As String):    m.msgLogDelimList = value: End Property

Public Property Get msgLogDelimNamePath() As String:    msgLogDelimNamePath = m.msgLogDelimNamePath: End Property
Public Property Let msgLogDelimNamePath(value As String):    m.msgLogDelimNamePath = value: End Property
   


'''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''' Shadow i/o ''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''

Public Function load() As Boolean
    On Error GoTo trap
    ''
    With New clsFile
        deserialize .load(s.agencyConfigFile)
    End With
    
    RaiseEvent Loaded(Me)
    
    load = True
    Exit Function
trap:
    Select Case err.Number
        Case 1
        Case Else
            MsgBox formatErr
    End Select

End Function


Public Function save() As Boolean
    On Error GoTo trap
    
    With New clsFile
        save = .save(serialize())
    End With
    save = True
    Exit Function
trap:
    errRaise "save"
End Function

==serialize==
<pre style="margin-left:3em; font:normal 14px terminal;">
Public Function serialize(rootPrefix As String) As String

    Dim config(1 To 25) As String
    
    With m        
        config(1) = "agencyDataFolder" + SKV_DELIM_PAIR + .processName
        config(2) = "agencyConfigFile" + SKV_DELIM_PAIR + .skvAlloc
        config(3) = "agencyOptionsFile" + SKV_DELIM_PAIR + .skvFile
        config(4) = "agencyModuleName" + SKV_DELIM_PAIR + .agencyModuleName
                
        config(4) = "agencyTitle" + SKV_DELIM_PAIR + .agencyTitle
        config(5) = "agencyParentPath" + SKV_DELIM_PAIR + .agencyParentPath
        
        config(6) = "cmdArgPairDelim" + SKV_DELIM_PAIR + .cmdArgPairDelim
        config(7) = "cmdArgsDelim" + SKV_DELIM_PAIR + .cmdArgsDelim
        config(8) = "cmdsAllocChunk" + SKV_DELIM_PAIR + .cmdsAllocChunk
        config(9) = "cmdsDelim" + SKV_DELIM_PAIR + .cmdsDelim
                            
        config(10) = "selEndpointID" + SKV_DELIM_PAIR + .selEndpointID
        config(11) = "selEngineerID" + SKV_DELIM_PAIR + .selEngineerID
        config(12) = "selPromptID" + SKV_DELIM_PAIR + .selPromptID
        config(13) = "selQueryID" + SKV_DELIM_PAIR + .selQueryID
        config(14) = "selResponseID" + SKV_DELIM_PAIR + .selResponseID
        config(15) = "selConfigFile" + SKV_DELIM_PAIR + .selConfigFile
        
        config(16) = "skvAllocChunk" + SKV_DELIM_PAIR + .skvAllocChunk
        config(17) = "skvDelimKey" + SKV_DELIM_PAIR + .skvDelimKey
        config(18) = "skvDelimList" + SKV_DELIM_PAIR + .skvDelimList
        config(19) = "skvDelimPair" + SKV_DELIM_PAIR + .skvDelimPair
        config(20) = "skvDelimValues" + SKV_DELIM_PAIR + .skvDelimValues
        
        config(21) = "msgsAllocChunk" + SKV_DELIM_PAIR + .msgLogAllocChunk
        config(22) = "msgDelimElements" + SKV_DELIM_PAIR + .msgLogDelimElements
        config(23) = "msgsDelimList" + SKV_DELIM_PAIR + .msgLogDelimList
        config(24) = "msgDelimNamePath" + SKV_DELIM_PAIR + .msgLogDelimNamePath
        
        config(25) = "xNodeDelimKey" + SKV_DELIM_PAIR + .xNodeDelimKey
    End With
    
    serialize = Join(config, SKV_DELIM_LIST)
End Function

</pre>

==deserialize==
<pre style="margin-left:3em; font:normal 14px terminal;">
Public Function deserializeSKV(skvConfiguration As String) As Boolean
    Dim config(1 To 25)
    
    config = Split(skvConfiguration, SKV_DELIM_LIST)
    
    With m
        m.SKV = Split(skvConfiguration, SKV_DELIM_LIST)
        
    End With

    deserializeSKV = True
    Exit Function
trap:
    errRaise "deserializeSKV"
End Function

Public Function append(SKV As String, _
                       value As String _
                       ) As Long
    ''  Return index of appended SKV element
    On Error GoTo trap
    
    With m
        
    End With
trap:
    Select Case err.Number
        Case 9 'array failed to
            ''  Allocate more array storage
            If .skvCount > UBound(.SKV) Then
                err.clear
                On Error Resume Next
                ReDim Preserve m.SKV(1 To .skvCount + .skvAlloc)
                If Not err Then Resume
            End If
        Case Else
            MSGL
            errRaise "Non-trapped error appending SKV=value Options element"
    End Select
End Function
</pre>