845 lines
28 KiB
OpenEdge ABL
845 lines
28 KiB
OpenEdge ABL
VERSION 1.0 CLASS
|
|
BEGIN
|
|
MultiUse = -1 'True
|
|
Persistable = 0 'NotPersistable
|
|
DataBindingBehavior = 0 'vbNone
|
|
DataSourceBehavior = 0 'vbNone
|
|
MTSTransactionMode = 0 'NotAnMTSObject
|
|
END
|
|
Attribute VB_Name = "clsConfiguration"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = False
|
|
' ====================================================================================
|
|
' INTRODUCTION
|
|
' ====================================================================================
|
|
'
|
|
' Configuration Class Module by Pascal vd Heiden, www.codeimp.com
|
|
'
|
|
' This Class module contains code of my design. You are free to use it,
|
|
' as long as you do not remove my details up here in this comment. Thanks.
|
|
'
|
|
' This Class module requires "Microsoft Scripting Runtime" reference (scrrun.dll)
|
|
' for the Dictionary object. Select this in the Project -> References dialog.
|
|
'
|
|
' Can safely be compiled with Fast Optimization and
|
|
' all Advanced Optimization switches checked.
|
|
'
|
|
'
|
|
' ====================================================================================
|
|
' CONFIGURATION FILE STRUCTURE SYNTAX
|
|
' ====================================================================================
|
|
'
|
|
' Whitepace is always allowed. This includes spaces, tabs
|
|
' linefeeds (10) and carriage returns (13)
|
|
'
|
|
' Keys may not have spaces or assignment operator = in them.
|
|
'
|
|
' Comments start with // (unless used within strings)
|
|
' and count as comment for the rest of the line. Or use /* and */
|
|
' to mark the beginning and end of a comment.
|
|
'
|
|
' Simple setting:
|
|
'
|
|
' key = value;
|
|
'
|
|
' Example: speed = 345;
|
|
' cars = 8;
|
|
'
|
|
' Strings must be in quotes.
|
|
'
|
|
' Example: nickname = "Gherkin";
|
|
' altnick = "Gherk inn";
|
|
'
|
|
' String Escape Sequences:
|
|
' \n New line (10)
|
|
' \r Carriage return (13)
|
|
' \t Tab (9)
|
|
' \" Double-quotation mark
|
|
' \\ Backslash
|
|
' \000 Any ASCII character (MUST be 3 digits! So for 13 you use \013)
|
|
'
|
|
' Decimals ALWAYS use a dot, NEVER comma!
|
|
'
|
|
' Example: pressure = 15.29;
|
|
' acceleration = 1.0023;
|
|
'
|
|
' Structures must use brackets.
|
|
'
|
|
' Structure Example:
|
|
'
|
|
' key
|
|
' {
|
|
' key = value;
|
|
' key = value;
|
|
'
|
|
' key
|
|
' {
|
|
' key = value;
|
|
' key = value;
|
|
' key = value;
|
|
' }
|
|
'
|
|
' key = value;
|
|
' key = value;
|
|
' key = value;
|
|
' key = value;
|
|
' key = value;
|
|
' }
|
|
'
|
|
' As you can see, structures inside structures are allowed
|
|
' and you may go as deep as you want. Note that only the root structures
|
|
' can be readed from config using ReadSetting. ReadSetting will return a
|
|
' Dictionary object containing everything in that root structure.
|
|
'
|
|
' Key names must be unique within their scope.
|
|
'
|
|
' This is NOT allowed, it may not have 'father' more
|
|
' than once in the same scope:
|
|
'
|
|
' mother = 45;
|
|
' father = 52;
|
|
'
|
|
' father
|
|
' {
|
|
' length = 1.87;
|
|
' }
|
|
'
|
|
' This however is allowed, because father
|
|
' now exists in a different scope:
|
|
'
|
|
' mother = 45;
|
|
' father = 52;
|
|
'
|
|
' parents
|
|
' {
|
|
' father = 52;
|
|
' }
|
|
'
|
|
' This too is allowed, both 'age' are in a different scope:
|
|
'
|
|
' mother
|
|
' {
|
|
' age = 45;
|
|
' }
|
|
'
|
|
' father
|
|
' {
|
|
' age = 52;
|
|
' }
|
|
'
|
|
'
|
|
' ====================================================================================
|
|
' FUNCTION CALL DESCRIPTIONS
|
|
' ====================================================================================
|
|
'
|
|
' InputConfiguration
|
|
'
|
|
' This loads a configuration from a string. The string must contain a
|
|
' configuration using the rules described above.
|
|
'
|
|
' ------------------------------------------------------------------------------------
|
|
'
|
|
' LoadConfiguration
|
|
'
|
|
' Loads a configuration from a file. The file must contain a configuration
|
|
' using the rules described above.
|
|
'
|
|
' ------------------------------------------------------------------------------------
|
|
'
|
|
' NewConfiguration
|
|
'
|
|
' Erases all loaded settings and starts with a new, clear configuration
|
|
'
|
|
' ------------------------------------------------------------------------------------
|
|
'
|
|
' OutputConfiguration
|
|
'
|
|
' Returns the configuration as a string following the rules described above.
|
|
' You can optionally determine the newline character to use and/or omit
|
|
' whitespace in the result.
|
|
'
|
|
' ------------------------------------------------------------------------------------
|
|
'
|
|
' SaveConfiguration
|
|
'
|
|
' Writes the configuration to file following the rules described above.
|
|
' You can optionally specify the newline character to use and/or omit
|
|
' whitespace in the result.
|
|
'
|
|
' ------------------------------------------------------------------------------------
|
|
'
|
|
' ReadSetting
|
|
'
|
|
' Reads a setting from the root level and returns it in its own variable type.
|
|
' You can optionally specify a default to return if the specified setting
|
|
' does not exist and/or specify if you would like to get a reference if the
|
|
' setting is a Dictionary object (structure in configuration).
|
|
' If you use a reference, you can change the configuration immediately
|
|
' through that reference.
|
|
'
|
|
' ------------------------------------------------------------------------------------
|
|
'
|
|
' WriteSetting
|
|
'
|
|
' Writes a setting to the root level in the configuration.
|
|
' You can choose to write the setting as reference if it is of Dictionary type.
|
|
' Note that your configuration changes too when you change anything
|
|
' in your Dictionary when it is written as reference!
|
|
'
|
|
' ------------------------------------------------------------------------------------
|
|
'
|
|
' RemoveSetting
|
|
'
|
|
' Removes a setting from the root level in the configuration.
|
|
' Its as simple as that. What else is there to tell about it?!
|
|
'
|
|
' ------------------------------------------------------------------------------------
|
|
'
|
|
' Root
|
|
'
|
|
' Returns the entire configuration (root level) as a Dictionary object.
|
|
' You can optionally specify to return a reference through which you can change
|
|
' the configuration immediately.
|
|
'
|
|
' ====================================================================================
|
|
' ====================================================================================
|
|
|
|
|
|
|
|
'Do not allow any undeclared variables
|
|
Option Explicit
|
|
|
|
'Case sensitive comparisions
|
|
Option Compare Binary
|
|
|
|
Private Const ASSIGNOP As Long = 61 ' =
|
|
Private Const BEGINOP As Long = 123 ' {
|
|
Private Const ENDOP As Long = 125 ' }
|
|
Private Const TERMINATEOP As Long = 59 ' ;
|
|
Private Const STRINGOP As Long = 34 ' "
|
|
Private Const COMMENT As String = "//" '
|
|
Private Const BEGINCOMMENT As String = "/*" '
|
|
Private Const ENDCOMMENT As String = "*/" '
|
|
|
|
Private Const WS_SPACE As Long = 32 ' space
|
|
Private Const WS_LINEFEED As Long = 10 ' linefeed
|
|
Private Const WS_TAB As String = vbTab '
|
|
Private Const WS_RETURN As String = vbCr '
|
|
|
|
Private Const ESCAPESEQ As Long = 92 ' \
|
|
Private Const ES_NEWLINE As Long = 110 ' n
|
|
Private Const ES_RETURN As Long = 114 ' r
|
|
Private Const ES_TAB As Long = 116 ' t
|
|
Private Const ES_QUOTE As Long = 34 ' "
|
|
Private Const ES_BACKSLASH As Long = 92 ' \
|
|
|
|
'This will hold the object orientated configuration
|
|
Private Config As Dictionary
|
|
|
|
'Last line that was read where error occurred
|
|
Private cLastReadLine As Long
|
|
|
|
Public Property Get CurrentScanLine() As Long
|
|
CurrentScanLine = cLastReadLine
|
|
End Property
|
|
|
|
Private Sub Class_Initialize()
|
|
|
|
'New database
|
|
Set Config = New Dictionary
|
|
End Sub
|
|
|
|
Private Sub Class_Terminate()
|
|
|
|
'Clean up
|
|
Set Config = Nothing
|
|
End Sub
|
|
|
|
Private Function DeepCopy(ByRef Dict As Dictionary) As Dictionary
|
|
Dim NewConfig As Dictionary
|
|
Dim CopyObject As Dictionary
|
|
Dim ConfigKeys As Variant
|
|
Dim ConfigValue As Variant
|
|
Dim i As Long
|
|
|
|
'Create new config
|
|
Set NewConfig = New Dictionary
|
|
|
|
'Add all items from Config
|
|
If Dict.Count Then
|
|
ConfigKeys = Dict.Keys
|
|
For i = LBound(ConfigKeys) To UBound(ConfigKeys)
|
|
|
|
'Check if the value is a dictionary
|
|
If VarType(Dict(ConfigKeys(i))) = vbObject Then
|
|
|
|
'Get the object
|
|
Set CopyObject = Dict(ConfigKeys(i))
|
|
|
|
'Deepcopy this too
|
|
NewConfig.Add ConfigKeys(i), DeepCopy(CopyObject)
|
|
|
|
'Clean up
|
|
Set CopyObject = Nothing
|
|
Else
|
|
|
|
'Normal copy
|
|
ConfigValue = Dict(ConfigKeys(i))
|
|
NewConfig.Add ConfigKeys(i), ConfigValue
|
|
End If
|
|
Next i
|
|
End If
|
|
|
|
'Return the result
|
|
Set DeepCopy = NewConfig
|
|
|
|
'Clean up
|
|
Set NewConfig = Nothing
|
|
End Function
|
|
|
|
Private Function Escaped(ByRef Value As String) As String
|
|
|
|
' \n New line
|
|
' \r Carriage return
|
|
' \t Tab
|
|
' \" Double quotation mark
|
|
' \\ Backslash
|
|
|
|
'Copy string
|
|
Escaped = Value
|
|
|
|
'Replace characters with escape sequences
|
|
Escaped = Replace$(Escaped, "\", "\\") 'Note the \ must be the first to replace!
|
|
Escaped = Replace$(Escaped, vbLf, "\n")
|
|
Escaped = Replace$(Escaped, vbCr, "\r")
|
|
Escaped = Replace$(Escaped, vbTab, "\t")
|
|
Escaped = Replace$(Escaped, """", "\""")
|
|
End Function
|
|
|
|
Public Sub InputConfiguration(ByVal Configuration As String)
|
|
|
|
|
|
'This reads the data and builds a new dictionary object
|
|
|
|
|
|
'Remove Returns and Tabs so we only have Linefeed as newline
|
|
Configuration = Replace$(Configuration, WS_RETURN, "")
|
|
Configuration = Replace$(Configuration, WS_TAB, "")
|
|
|
|
|
|
'First line
|
|
cLastReadLine = 1
|
|
|
|
'Load main structure
|
|
Set Config = LoadStructure(0, Configuration)
|
|
End Sub
|
|
|
|
Public Sub LoadConfiguration(ByRef Filename As String)
|
|
Dim FB As Integer 'File buffer
|
|
Dim Data As String 'Data
|
|
|
|
|
|
'This reads a file and builds a new dictionary object
|
|
|
|
|
|
'Open the file to read
|
|
FB = FreeFile
|
|
Open Filename For Binary As #FB
|
|
|
|
'Read all data
|
|
Data = Space$(LOF(FB))
|
|
Get #FB, 1, Data
|
|
|
|
'Close file
|
|
Close #FB
|
|
|
|
|
|
'Remove Returns and Tabs so we only have Linefeed as newline
|
|
Data = Replace$(Data, WS_RETURN, "")
|
|
Data = Replace$(Data, WS_TAB, "")
|
|
|
|
|
|
'First line
|
|
cLastReadLine = 1
|
|
|
|
'Load main structure
|
|
Set Config = LoadStructure(0, Data)
|
|
End Sub
|
|
|
|
Private Function LoadStructure(ByRef p As Long, ByRef Data As String) As Dictionary
|
|
Dim c As String * 1 'Character at p
|
|
Dim ca As Long 'ASCII value of c
|
|
Dim np As Long 'Next position
|
|
Dim StringData As Boolean 'True if in a string
|
|
Dim NumberData As Boolean 'True if in a number
|
|
Dim Sequence As Boolean 'True if getting a sequence character
|
|
Dim Assigning As Boolean 'True when assigning
|
|
Dim NewKey As String
|
|
Dim NewValue As String
|
|
|
|
'Create dictionary
|
|
Set LoadStructure = New Dictionary
|
|
|
|
'Continue until end of data
|
|
Do While p < Len(Data)
|
|
|
|
'Next char
|
|
p = p + 1
|
|
|
|
'Get char
|
|
c = Mid$(Data, p, 1)
|
|
ca = AscW(c)
|
|
|
|
'Check if we are processing number data
|
|
If NumberData Then
|
|
|
|
'Check if assignment ends
|
|
If ca = TERMINATEOP Then
|
|
|
|
'Check number type
|
|
If InStr(NewValue, ".") <> 0 Then
|
|
|
|
'Add the number to dictionary as single
|
|
LoadStructure.Add Trim$(NewKey), CSng(Val(NewValue))
|
|
Else
|
|
|
|
'Add the number to dictionary as long
|
|
LoadStructure.Add Trim$(NewKey), CLng(NewValue)
|
|
End If
|
|
|
|
'Reset
|
|
NewKey = ""
|
|
NewValue = ""
|
|
|
|
'End of assign
|
|
NumberData = False
|
|
Assigning = False
|
|
|
|
'Check if newline
|
|
ElseIf (ca = WS_LINEFEED) Then
|
|
|
|
'Count the new line
|
|
cLastReadLine = cLastReadLine + 1
|
|
Else
|
|
|
|
'Add to value
|
|
NewValue = NewValue & c
|
|
End If
|
|
|
|
'Check if we are processing string data
|
|
ElseIf StringData Then
|
|
|
|
'Check if previous char was a slash
|
|
If Sequence Then
|
|
|
|
'Check the char
|
|
Select Case ca
|
|
Case ES_BACKSLASH: NewValue = NewValue & "\"
|
|
Case ES_NEWLINE: NewValue = NewValue & vbLf
|
|
Case ES_QUOTE: NewValue = NewValue & """"
|
|
Case ES_RETURN: NewValue = NewValue & vbCr
|
|
Case ES_TAB: NewValue = NewValue & vbTab
|
|
Case Else
|
|
|
|
'Check if its a number
|
|
If IsNumeric(c) Then
|
|
|
|
'Always 3 chars
|
|
np = CLng(Mid$(Data, p, 3))
|
|
NewValue = NewValue & ChrW$(np)
|
|
p = p + 2
|
|
Else
|
|
|
|
'Add character
|
|
NewValue = NewValue & c
|
|
End If
|
|
End Select
|
|
|
|
'End of sequence
|
|
Sequence = False
|
|
Else
|
|
|
|
'Check if sequence start
|
|
If ca = ESCAPESEQ Then
|
|
|
|
'Start escape sequence
|
|
Sequence = True
|
|
|
|
'Check if string ends
|
|
ElseIf ca = STRINGOP Then
|
|
|
|
'Add the string to dictionary
|
|
LoadStructure.Add Trim$(NewKey), NewValue
|
|
|
|
'End of string
|
|
StringData = False
|
|
|
|
'Reset
|
|
NewKey = ""
|
|
NewValue = ""
|
|
|
|
'Check if newline
|
|
ElseIf (ca = WS_LINEFEED) Then
|
|
|
|
'Count the new line
|
|
cLastReadLine = cLastReadLine + 1
|
|
|
|
Else
|
|
|
|
'Add to string
|
|
NewValue = NewValue & c
|
|
End If
|
|
End If
|
|
|
|
'Check if assigning
|
|
ElseIf Assigning Then
|
|
|
|
'Check for STRINGOP or Numeric character
|
|
If (ca = STRINGOP) Then
|
|
|
|
'Begin string data here
|
|
StringData = True
|
|
|
|
ElseIf (IsNumeric(c) = True) Or (c = "-") Or (c = ".") Or (LCase$(c) = "e") Or (c = "&") Then
|
|
|
|
'Begin numeric data here
|
|
NumberData = True
|
|
|
|
'Note that this byte is part of the value
|
|
p = p - 1
|
|
|
|
'Check if newline
|
|
ElseIf (ca = WS_LINEFEED) Then
|
|
|
|
'Count the new line
|
|
cLastReadLine = cLastReadLine + 1
|
|
|
|
'Check if assignment ends
|
|
ElseIf (ca = TERMINATEOP) Then
|
|
|
|
'End of assign
|
|
Assigning = False
|
|
|
|
'Everything else but spaces are not allowed
|
|
ElseIf (ca <> WS_SPACE) Then
|
|
|
|
'Invalid assignment
|
|
Err.Raise vbObjectError, , "Invalid assignment. Forgot an assignment terminator?"
|
|
End If
|
|
|
|
'Anything else
|
|
Else 'If (ca <> WS_SPACE) Then
|
|
|
|
'Check for a Key, BEGINOP, ENDOP or ASSIGNOP, COMMENT or whitespace
|
|
Select Case ca
|
|
Case BEGINOP
|
|
|
|
'Check for spaces in key name
|
|
If (InStr(Trim$(NewKey), " ") > 0) Then
|
|
|
|
'Spaces not allowed in key names
|
|
Err.Raise vbObjectError, , "Spaces not allowed in key names."
|
|
Else
|
|
|
|
'Add structure
|
|
LoadStructure.Add Trim$(NewKey), LoadStructure(p, Data)
|
|
|
|
'Reset
|
|
NewKey = ""
|
|
End If
|
|
|
|
Case ENDOP
|
|
|
|
'Leave here
|
|
Exit Do
|
|
|
|
Case ASSIGNOP
|
|
|
|
'Check for spaces in key name
|
|
If (InStr(Trim$(NewKey), Chr$(WS_SPACE)) > 0) Then
|
|
|
|
'Spaces not allowed in key names
|
|
Err.Raise vbObjectError, , "Spaces not allowed in key names."
|
|
Else
|
|
|
|
'Now assigning
|
|
Assigning = True
|
|
End If
|
|
|
|
Case TERMINATEOP
|
|
|
|
'Add the key to dictionary with 0 value
|
|
LoadStructure.Add Trim$(NewKey), CLng(0)
|
|
|
|
'Reset
|
|
NewKey = ""
|
|
NewValue = ""
|
|
|
|
Case WS_LINEFEED
|
|
|
|
'Count the new line
|
|
cLastReadLine = cLastReadLine + 1
|
|
|
|
'Add as space
|
|
NewKey = NewKey & Chr$(WS_SPACE)
|
|
|
|
'Check for possible comment
|
|
Case AscW(COMMENT), AscW(BEGINCOMMENT)
|
|
|
|
'Check for 2 bytes line comment
|
|
If Mid$(Data, p, 2) = COMMENT Then
|
|
|
|
'Find the next linefeed
|
|
np = InStr(p, Data, vbLf)
|
|
|
|
'Check if linefeed was found
|
|
If np > 0 Then
|
|
|
|
'Count linefeed
|
|
cLastReadLine = cLastReadLine + 1
|
|
|
|
'Skip to next
|
|
p = np
|
|
Else
|
|
|
|
'No linefeed can be found, end of file!
|
|
p = Len(Data)
|
|
Exit Do
|
|
End If
|
|
|
|
'Check for 2 bytes block comment
|
|
ElseIf Mid$(Data, p, 2) = BEGINCOMMENT Then
|
|
|
|
'Find the next endcomment
|
|
np = InStr(p, Data, ENDCOMMENT)
|
|
|
|
'Check if endcomment was found
|
|
If np > 0 Then
|
|
|
|
'Count the number of linefeeds in comment block
|
|
cLastReadLine = cLastReadLine + UBound(Split(Mid$(Data, p, np - p), Chr$(WS_LINEFEED)))
|
|
|
|
'Skip to next
|
|
p = np + 1
|
|
Else
|
|
|
|
'No endcomment can be found, end of file!
|
|
p = Len(Data)
|
|
Exit Do
|
|
End If
|
|
End If
|
|
|
|
'Add to key name
|
|
Case Else: NewKey = NewKey & c
|
|
|
|
End Select
|
|
End If
|
|
Loop
|
|
End Function
|
|
|
|
Public Sub NewConfiguration()
|
|
|
|
'First line
|
|
cLastReadLine = 1
|
|
|
|
'Create new, empty dictionary
|
|
Set Config = New Dictionary
|
|
End Sub
|
|
|
|
Public Function OutputConfiguration(Optional ByVal NewLine As String = vbCrLf, Optional ByVal Whitespace As Boolean = True) As String
|
|
|
|
'Create configuration as string
|
|
OutputConfiguration = OutputDictionary(Config, 0, NewLine, Whitespace)
|
|
End Function
|
|
|
|
Private Function OutputDictionary(ByRef Dict As Dictionary, ByVal Level As Long, Optional ByVal NewLine = vbCrLf, Optional ByVal Whitespace As Boolean = True) As String
|
|
Dim LevelTabs As String
|
|
Dim sp As String
|
|
Dim Keys As Variant
|
|
Dim Data As String
|
|
Dim i As Long
|
|
|
|
'Check if this dictionary is not empty
|
|
If Dict.Count > 0 Then
|
|
|
|
'Create whitespace
|
|
If Whitespace Then
|
|
LevelTabs = String$(Level, vbTab)
|
|
sp = " "
|
|
End If
|
|
|
|
'Get the keys
|
|
Keys = Dict.Keys
|
|
|
|
'Go for all keys in dictionary
|
|
For i = LBound(Keys) To UBound(Keys)
|
|
|
|
'Check type of value
|
|
Select Case VarType(Dict(Keys(i)))
|
|
|
|
'Dictionary Object
|
|
Case vbObject
|
|
|
|
'Output empty line
|
|
If Whitespace Then Data = Data & LevelTabs & NewLine
|
|
|
|
'Output the key
|
|
Data = Data & LevelTabs & Keys(i) & NewLine
|
|
|
|
'Ouput the BEGINOP
|
|
Data = Data & LevelTabs & ChrW$(BEGINOP) & NewLine
|
|
|
|
'Output Dictionary
|
|
Data = Data & OutputDictionary(Dict(Keys(i)), Level + 1, NewLine, Whitespace)
|
|
|
|
'Output the ENDOP
|
|
Data = Data & LevelTabs & ChrW$(ENDOP) & NewLine
|
|
|
|
'Output empty line
|
|
If Whitespace Then Data = Data & LevelTabs & NewLine
|
|
|
|
'Integral Number
|
|
Case vbInteger, vbLong, vbByte
|
|
|
|
'Output the key = value;
|
|
Data = Data & LevelTabs & Keys(i) & sp & ChrW$(ASSIGNOP) & sp & Dict(Keys(i)) & ChrW$(TERMINATEOP) & NewLine
|
|
|
|
'Floating point Number
|
|
Case vbSingle, vbDouble, vbCurrency, vbDecimal
|
|
|
|
'Output the key = value;
|
|
Data = Data & LevelTabs & Keys(i) & sp & ChrW$(ASSIGNOP) & sp & Format(Dict(Keys(i)), "###############################0.0#####") & "f" & ChrW$(TERMINATEOP) & NewLine
|
|
|
|
'Boolean as Number
|
|
Case vbBoolean
|
|
|
|
'Output the key = value;
|
|
Data = Data & LevelTabs & Keys(i) & sp & ChrW$(ASSIGNOP) & sp & CLng(Dict(Keys(i))) & ChrW$(TERMINATEOP) & NewLine
|
|
|
|
'Other (String)
|
|
Case Else
|
|
|
|
'Output the key = "value";
|
|
Data = Data & LevelTabs & Keys(i) & sp & ChrW$(ASSIGNOP) & sp & ChrW$(STRINGOP) & Escaped(Dict(Keys(i))) & ChrW$(STRINGOP) & ChrW$(TERMINATEOP) & NewLine
|
|
|
|
End Select
|
|
Next i
|
|
End If
|
|
|
|
'Return data
|
|
OutputDictionary = Data
|
|
End Function
|
|
|
|
Public Function ReadSetting(ByRef Setting As String, Optional ByRef Default As Variant, Optional ByVal Reference As Boolean)
|
|
|
|
'Check if setting exists
|
|
If Config.Exists(Setting) Then
|
|
|
|
'Check setting type
|
|
If VarType(Config(Setting)) = vbObject Then
|
|
|
|
'Check if we should return a reference
|
|
If Reference Then
|
|
|
|
'Return a reference
|
|
Set ReadSetting = Config(Setting)
|
|
Else
|
|
|
|
'Return the setting
|
|
Set ReadSetting = DeepCopy(Config(Setting))
|
|
End If
|
|
Else
|
|
|
|
'Return the setting
|
|
ReadSetting = Config(Setting)
|
|
End If
|
|
Else
|
|
|
|
'Return the default
|
|
If VarType(Default) = vbObject Then Set ReadSetting = Default Else ReadSetting = Default
|
|
End If
|
|
End Function
|
|
|
|
Public Sub RemoveSetting(ByRef Setting As String)
|
|
|
|
'Remove setting if exists
|
|
If Config.Exists(Setting) Then Config.Remove Setting
|
|
End Sub
|
|
|
|
Public Function Root(Optional ByVal Reference As Boolean) As Dictionary
|
|
|
|
'Check if we should return a reference
|
|
If Reference Then
|
|
|
|
'Return a reference
|
|
Set Root = Config
|
|
Else
|
|
|
|
'Return the setting
|
|
Set Root = DeepCopy(Config)
|
|
End If
|
|
End Function
|
|
|
|
Public Sub SaveConfiguration(ByRef Filename As String, Optional ByVal NewLine As String = vbCrLf, Optional ByVal Whitespace As Boolean = True)
|
|
Dim FB As Integer 'File buffer
|
|
Dim Data As String 'Data
|
|
|
|
|
|
'This reads a file and builds a new dictionary object
|
|
|
|
|
|
'Create data
|
|
Data = OutputDictionary(Config, 0, NewLine, Whitespace)
|
|
|
|
|
|
'Kill the file if exists
|
|
If Dir(Filename) <> "" Then Kill Filename
|
|
|
|
'Open the file to write
|
|
FB = FreeFile
|
|
Open Filename For Binary As #FB
|
|
|
|
'Write configuration data
|
|
Put #FB, 1, Data
|
|
|
|
'Close file
|
|
Close #FB
|
|
End Sub
|
|
|
|
Public Sub WriteSetting(ByRef Setting As String, ByRef Value As Variant, Optional ByVal Reference As Boolean)
|
|
Dim DictValue As Dictionary
|
|
|
|
'Check if the setting exists
|
|
If Config.Exists(Setting) Then
|
|
|
|
'Check type of value
|
|
If VarType(Value) = vbObject Then
|
|
|
|
'Check if we should apply referenced
|
|
If Reference Then
|
|
|
|
'Apply setting as reference
|
|
Set Config(Setting) = Value
|
|
Else
|
|
|
|
'Apply setting
|
|
Set DictValue = Value
|
|
Set Config(Setting) = DeepCopy(DictValue)
|
|
|
|
'Clean up
|
|
Set DictValue = Nothing
|
|
End If
|
|
Else
|
|
|
|
'Apply setting
|
|
Config(Setting) = Value
|
|
End If
|
|
Else
|
|
|
|
'Add setting
|
|
Config.Add Setting, Value
|
|
End If
|
|
End Sub
|