• Home
 · 
• String Manipulation
 · 
• This class gives functionality to create, remove and amend pseudo-variables 'on the fly'. A very us

This class gives functionality to create, remove and amend pseudo-variables 'on the fly'. A very us

This class gives functionality to create, remove and amend pseudo-variables 'on the fly'. A very useful piece of code.

Rate This class gives functionality to create, remove and amend pseudo-variables 'on the fly'. A very us

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'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