Contents in this wiki are for entertainment purposes only
This is not fiction ∞ this is psience of mind

Xenotools VB6 Edition: Difference between revisions

From Catcliffe Development
Jump to navigation Jump to search
(Created page with "{{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> <pre style="background-color: lightpink;"> Option Explicit Public Event initialized(class as st...")
 
m (Replaced content with "{{menuXenotoolsVB6}}")
Tag: Replaced
 
Line 1: Line 1:
{{menuXenotoolsVB6}}
{{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>
<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()
</pre>
   
<pre style="background-color: lavenderpink;">
Private Const CLASS_NAME = "Options"
Private Enum enumStati
    initialized = 1
    loaded
    saved
End Enum
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:aliceblue;">
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 >
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 '''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''
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 skvAllocChunk() As Long:    skvAllocChunk = m.skvAllocChunk: End Property
Public Property Let skvAllocChunk(value As Long):    m.skvAllocChunk = value: End Property
Public Property Get skvAllocInit() As Long:    skvAllocInit = m.skvAllocInit: End Property
Public Property Let skvAllocInit(value As Long):    m.skvAllocInit = 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 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>

Latest revision as of 20:46, 21 April 2025

VB6 Xenotools
SKV_Array_Class  ∞ 
SKV_Array_Class  ∞ 

Retrieved from "http://groupkos.com/dev/index.php?title=Xenotools_VB6_Edition&oldid=5063"