XenoEngineer: Replaced content with "{{menuXenotoolsVB6}}"

2025-04-21T20:46:40Z

Replaced content with "{{menuXenotoolsVB6}}"

XenoEngineer: Created page with "{{menuXenotoolsVB6}}

 ''  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 st..."

2025-04-21T20:30:10Z

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

New page

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

Xenotools VB6 Edition - Revision history

XenoEngineer: Replaced content with "{{menuXenotoolsVB6}}"