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

Xenotools VB6 Edition

From Catcliffe Development
Revision as of 20:30, 21 April 2025 by XenoEngineer (talk | contribs) (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...")
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to navigation Jump to search

VB6 Xenotools
SKV_Array_Class  ∞ 
SKV_Array_Class  ∞  

''  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
''

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 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



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

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


'''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''' 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

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

deserialize

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
Retrieved from "http://groupkos.com/dev/index.php?title=Xenotools_VB6_Edition&oldid=5060"