by Matt Hogg (2 Submissions)
Category: String Manipulation
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Wed 13th August 2003
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
This class gives functionality to create, remove and amend pseudo-variables 'on the fly'. A very useful piece of code.
VBcoders
'Roaming variable class
'======================
'
'Written: 1 December 2002 by Matt Hogg
'
'This class gives functionality to create, remove and amend pseudo-variables 'on the fly'.
'All variables are held in a single string, but this class gives access to them as if they
'were part of a collection. This tool can be extremely fast, much faster than creating and
'building a Collection type.
'
'As the variable data is string based, it is not recommended that this is used for heavily-
'typed code. As it is, I have found it extremely useful for storing variables without
'declaration as re-compiling code to deal with new variables will (in most cases)
'affect binary compatibility.
'
'As it is, the code uses text comparison, so it would not be such a big deal to change to
'binary comparison, so you can have case-sensitive variables.
'
'Usage:
'
' .Clear
' - Clears down the variables.
'
' .Count()
' - Returns the amount of variables stored.
'
' .IDChange(CurrentVariableName, NewVariableName)
' - Changes a variable name...very useful.
'
' .ListData()
' - Returns a list of variables and values in VariableName=Value format.
'
' .ListItemID(Index)
' - Index is between 1 and Count(). Returns the variable name.
'
' .ListItemValue(Index)
' - Index is between 1 and Count(). Returns the variable value.
'
' .NeedsData()
' - Returns boolean. True = Empty variable list.
'
' .RawData()
' - Returns or sets the raw data. Can be used to store variable list away and retrieve
' later.
'
' .RemoveItem(Index)
' - Index is between 1 and Count(). Removes a variable.
'
' .RemoveValue(VariableName)
' - Removes a variable.
'
' .Value(VariableName)
' - Returns or sets the variable value. Variables do not have to be declared!
'
'
Private mstr_Data As String 'Contains the raw data
'As the code uses control codes to separate variables, values and rows, we need to encode any in
'the raw data
Private Function EncodeText(ByVal Text As Variant) As Variant
'Null text results in Null return
EncodeText = Null
If IsNull(Text) Then Exit Function
'$0, $1, $2 are control codes. Replace with /0, /1, /2 respectively
'As / is used, we need to replace that with // as well
EncodeText = Replace(Replace(Replace(Replace(Text, "/", "//"), Chr$(0), "/0"), Chr$(1), "/1"), Chr$(2), "/2")
End Function
'Decodes raw data that has been encoded by EncodeText
Private Function DecodeText(ByVal Text As Variant) As Variant
Dim l As Long 'Index for '/' char
'Text may be null. If so, Null result.
DecodeText = Null
If IsNull(Text) Then Exit Function
'Find the first instance of '/'
l = InStr(1, Text, "/")
'While there are '/' left in the text
Do While l > 0
'Append the text before the '/' to the result and adjust Text accordingly
DecodeText = DecodeText & Left$(Text, l - 1)
Text = Mid$(Text, l)
'What does the '/' encode?
Select Case Left$(Text, 2)
'An ordinary '/'
Case "//":
DecodeText = DecodeText & "/"
'Character code zero
Case "/0":
DecodeText = DecodeText & Chr$(0)
'Character code one
Case "/1":
DecodeText = DecodeText & Chr$(1)
'Character code two
Case "/2":
DecodeText = DecodeText & Chr$(2)
'Anything else shouldn't be here, but test for it anyway
Case Else:
'
End Select
'Adjust text so processed text/code is removed
Text = Mid$(Text, 3)
'Find the next '/' char
l = InStr(1, Text, "/")
Loop
'Append the remaining text and return the decoded result
DecodeText = DecodeText & Text
End Function
'Returns a count of the number of variables
Public Property Get Count() As Long
'Count the number of $0 character codes in the data
Count = Len(mstr_Data) - Len(Replace(mstr_Data, Chr$(0), ""))
End Property
'Returns the item variable name/ID. Index must be between 1 and Count()
Public Property Get ListItemID(ByVal Index As Long) As Variant
Dim l As Long 'Index of substring of new variable
Dim s As String 'Appended variable name/ID
'If Index is outside the range, exit with Null
ListItemID = Null
If Index > Count Then Exit Property
'Start at the beginning of the raw data
l = 1
'Search for the variable
Do While Index > 0
'Variable start is denoted by a zero character code
l = InStr(l, mstr_Data, Chr$(0)) + 1
'Make sure we get the correct variable
Index = Index - 1
Loop
'Got the variable...Find the end of the variable ID/Name
'This is delimited by a character code one
s = Mid$(mstr_Data, l)
s = Left$(s, InStr(1, s, Chr$(1)) - 1)
'Return the variable name/ID
ListItemID = DecodeText(s)
End Property
'Removes a variable
Public Sub RemoveValue(ByVal ID As Variant)
'If a blank ID is supplied, exit the sub
If IsNull(ID) Then Exit Sub
If ID = "" Then Exit Sub
'Replace the variable ID and value with nothing
mstr_Data = Replace(mstr_Data, Chr$(0) & EncodeText(ID) & Chr$(1) & EncodeText(Value(ID)) & Chr$(2), "")
End Sub
'Remove a variable by its Index
Public Sub RemoveItem(ByVal Index As Long)
RemoveValue ListItemID(Index)
End Sub
'Returns the value of the variable - indexed
Public Property Get ListItemValue(ByVal Index As Long) As Variant
Dim l As Long 'Subscript index for variable value
Dim s As String 'Appendable return value
'If Index is outside of range, return a Null
ListItemValue = Null
If Index > Count Then Exit Property
'Start at the beginning of the raw data
l = 1
'Find variable
Do While Index > 0
'Get subscript of variable value position
l = InStr(l, mstr_Data, Chr$(1)) + 1
'Make sure we have the correct variable
Index = Index - 1
Loop
'Got the variable...find the end of the value
s = Mid$(mstr_Data, l)
s = Left$(s, InStr(1, s, Chr$(2)) - 1)
'Return the variable value - remembering the value is encoded, so decode
ListItemValue = DecodeText(s)
End Property
'If the variable list is empty then this will signify that
Public Property Get NeedsData() As Boolean
'If raw data is empty of characters, the list requires data
NeedsData = (mstr_Data = "")
End Property
'Changes the variable name
Public Property Let IDChange(ByVal KeyColValue As String, ByVal NewKeyColValue As String)
'Cannot change a variable name into an already existing variable name
KeyColValue = EncodeText(KeyColValue)
NewKeyColValue = EncodeText(NewKeyColValue)
If InStr(1, mstr_Data, Chr$(0) & NewKeyColValue & Chr$(1), vbTextCompare) > 0 Then Exit Property
'Change the variable name
mstr_Data = Replace(mstr_Data, Chr$(0) & KeyColValue & Chr$(1), Chr$(0) & NewKeyColValue & Chr$(1))
End Property
'Sets the value of a variable
Public Property Let Value(ByVal KeyColValue As Variant, ByVal myData As Variant)
Dim s1 As String 'Required for change of value
Dim s2 As String 'Required for change of value
Dim l As Long 'Subscript of variable
'If variable name is Null or blank then exit
If IsNull(KeyColValue) Then Exit Property
If KeyColValue="" Then Exit Property
'Encode the variable name and the value
KeyColValue = EncodeText(KeyColValue)
myData = EncodeText(myData)
'Look to see if variable already exists
If InStr(1, mstr_Data, Chr$(0) & KeyColValue & Chr$(1), vbTextCompare) > 0 Then
'Variable already exists; change the value
'Find the subscript
l = InStr(1, mstr_Data, Chr$(0) & KeyColValue & Chr$(1), vbTextCompare)
's1 will contain all the variables and their values before the existing variable
If l > 1 Then s1 = Left$(mstr_Data, l - 1)
'Find the end subscript of the variable and its value
l = InStr(l, mstr_Data, Chr$(2), vbTextCompare) + 1
's2 contains all the variables and their values after the existing variable
If l <= Len(mstr_Data) Then s2 = Mid$(mstr_Data, l)
'Update the raw data to set the variable value
mstr_Data = s1 & Chr$(0) & KeyColValue & Chr$(1) & myData & Chr$(2) & s2
Else
'Variable doesn't already exist, so attach to the end of the raw data
mstr_Data = mstr_Data & Chr$(0) & KeyColValue & Chr$(1) & myData & Chr$(2)
End If
End Property
'Returns a variable's value
Public Property Get Value(ByVal KeyColValue As Variant) As Variant
Dim l As Long 'Subscript to start of variable value
Dim l2 As Long 'Subscript to end of variable value
'If the variable name is Null, exit the property
Value = Null
If IsNull(KeyColValue) Then Exit Property
'Encode the variable name
KeyColValue = EncodeText(KeyColValue)
'Search for the variable within the raw data
l = InStr(1, mstr_Data, Chr$(0) & KeyColValue & Chr$(1))
'If variable not found then the result must be Null
If l = 0 Then
Value = Null
Exit Property
End If
'Move subscript to variable value
l = l + 2 + Len(KeyColValue)
'Find the end of the variable value
l2 = InStr(l, mstr_Data, Chr$(2))
'Retrieve and decode the encoded value
Value = DecodeText(Mid$(mstr_Data, l, l2 - l))
'A blank value is Null (this can be removed, BTW)
If Value = "" Then Value = Null
End Property
'Clears the variables
Public Sub Clear()
mstr_Data = ""
End Sub
'Returns a list of all the variables. Format: VariableName=VariableValue<CR><LF>...etc.
Public Function ListData() As String
ListData = DecodeText(Replace(Replace(Replace(mstr_Data, Chr$(0), ""), Chr$(1), "="), Chr$(2), vbCrLf))
End Function
'Returns the raw data
Public Property Get RawData() As Variant
RawData = mstr_Data
End Property
'Sets the raw data
Public Property Let RawData(ByVal NewValue As Variant)
'If the raw data doesn't exist, clear down the current variable list
If IsNull(NewValue) Then
Clear
Exit Property
End If
'Set the data
mstr_Data = NewValue
End Property
No comments have been posted about This class gives functionality to create, remove and amend pseudo-variables 'on the fly'. A very us. Why not be the first to post a comment about This class gives functionality to create, remove and amend pseudo-variables 'on the fly'. A very us.