Domino Code Fragment

Code Name*
Array Manipulation functions		Date*
9/18/98		Source (or email address if you prefer)*
Joseph Francis/IBM
IP address:.3.14.70.203
Description*
Commonly used functions for array manipulations: Explode, Implode, AddValues, RemoveEntries, RemoveNthEntries		Type*
LotusScript		Categories*
List Processing/Sorting
Implementation:
None (plug and play)		Required Client:
Server:
Limitations:
Comments:
Files/Graphics attachments (if applicable): Code:
Public Function RemoveNthEntries( NthToRemove, arrayToRemoveFrom ) As Variant
'=== Removes entries from arrayToRemoveFrom whos index value is in listEntriesToRemove
'=== Returns a variant that contains an array value
'=== NthToRemove and arrayToRemoveFrom can be either a Variant that contains an array
'=== or an Array ( this is the reason there is no data type defined )
   
    If Not Isarray( arrayToRemoveFrom ) Then Exit Function
   
'--- Store this return value in a variant to it can be converted into an array
    Dim IndexList As Variant
   
    Dim newList As Variant
    Dim i As Integer
    Dim checkList List As Integer
    Dim ctr As Long
    Dim lowVal As Integer, highVal As Integer
    Dim numToRemove As Integer
   
    lowVal = Lbound( arrayToRemoveFrom )
    highVal = Ubound( arrayToRemoveFrom )
   
'--- Loop through Nth Items to be removed
    Forall aValueToRemove In NthToRemove
'--- set value in list if number is in range of array bounds and is not a repeat
         If Cint( aValueToRemove ) >= lowVal And Cint( aValueToRemove ) <= highVal And Not Iselement( checkList( aValueToRemove )) Then
          checkList( aValueToRemove ) = 1
         numToRemove = numToRemove + 1
    End If
End Forall

'--- If there were not valid entries, then quit now and return NOTHING
If numToRemove = 0 Then Exit Function

'--- Resize array to hold the original number minus the number of entries being removed
Redim newList( highVal - lowVal - numToRemove )

'--- Loop through entries
ctr = 0
For i = lowVal To highVal
'--- If this index position is not in the checkList then
    If Not Iselement( checkList( i ) ) Then
'--- Add it to the new array and increment counter
         newList( ctr ) = arrayToRemoveFrom( i )
         ctr = ctr + 1
    End If
Next

RemoveNthEntries = newList
End Function


Function Explode( valueToExplode As String, Seperator As String) As Variant
'=== Gets the ValueToAdd and uses the Seperator as the
'=== delimiter to populate the Strings Array
   
    Dim Strings As Variant
   
    Dim myNewVal
    Dim start As Integer
    Dim delim As Integer
    Dim ctr As Integer
    Dim finalValue As String
   
    Redim myNewVal(0)
   
'--- Initialize
    ctr = 0
    delim = 0
    start = 1
   
'--- Get first position of Separator in valueToExplode
    delim = Instr(start,valueToExplode,Seperator)
   
'--- If the separator was not found then set the entire valueToExplode to the first array alot
    If delim = 0 Then
         myNewVal(0) = valueToExplode
    Else
'--- If separator found, then cycle through valueToExplode string looking for separator
' cycle until the separator is not found
         While delim > 0
'--- Increment Array Preserving current value
              Redim Preserve myNewVal(ctr)
              myNewVal(ctr) = Mid$(valueToExplode,start,delim - start)
               start = delim + Len( Seperator )
'--- Increment counter used to increment array
              ctr = ctr + 1
              delim = Instr(start,valueToExplode,Seperator)
         Wend
         
'--- Now that no more seperators have been found,
'--- see if there is any final data left over
         finalValue = Mid$(valueToExplode,start)
         
'--- If there is a finalValue then append it to the list
'--- (to handle test3 in Explode( "test1~test2~test3" ) )
         If finalValue <> "" Then
              Redim Preserve myNewVal(ctr)
              myNewVal(ctr) = finalValue
         End If
    End If
   
'--- Reset Strings using the freshly built array
    explode = myNewVal
End Function


Function Implode( valueToImplode, Seperator As String) As String
'=== Returns the value of the list or array imploded into a single string using separator
   
'--- If not array or list then quit
    If Not Isarray( valueToImplode ) And Not Islist( valueToImplode ) Then Exit Function
    Dim retVal As String
     Dim hitOne As Integer
   
    retVal = ""
'--- Loop through value to implode
    Forall aVal In valueToImplode
         
         If hitOne Then
'--- Append seperator and value to return value
              retVal = retVal & Seperator & aVal
         Else
'--- Set inital value of return value to first value
              retVal = aVal
              hitOne = True
         End If
    End Forall
   
    Implode = retVal
   
End Function


Public Function AddValues( valuesToAdd, valuesToAddTo, iStartAt As Integer ) As Variant
'=== Adds array or single value in valuesToAdd into valuesToAddTo array starting at the
'=== iStartAt position. The remaining values are pushed up to the end.
'=== Starting at 0 inserts at the beginning Starting at -1 appends to the end
    Dim iValuesToAdd As Integer
    Dim iValuesInStrings As Integer
    Dim newVal As Variant
    If Not Isarray( valuesToAddTo ) Then Exit Function
    iValuesInStrings = Ubound( valuesToAddTo) - Lbound( valuesToAddTo ) + 1
   
    Dim iBegin As Integer
     Dim ctr As Integer
    Dim i As Integer
    Dim iAppendFlag As Integer
    ctr = 0
    iAppendFlag = False
   
'--- Edit check iStartAt
'--- If iStartAt is Negative or above last entry in strings
    If iStartAt < 0 Or iStartAt > iValuesInStrings - 1 Then
'--- Get the next available entry in Strings
         iAppendFlag = True
         iBegin = iValuesInStrings
    Else
'--- Start where they said to start
         iBegin = iStartAt
    End If
'-- Calculate number of values being added
    iValuesToAdd = Ubound( valuesToAdd ) - Lbound( valuesToAdd ) + 1
'--- Redim to be able to hold the new values
    newVal = valuesToAddTo
    Redim Preserve newVal( Lbound( newVal ) To Ubound( newVal ) + iValuesToAdd )
'--- If this is not an append operation ....
'--- Move values from iBegin and up to the end, so the new values can be inserted
    If Not iAppendFlag Then
         For i = iValuesInStrings + iValuesToAdd - 1 To iValuesToAdd Step -1
              newVal(i) = newVal(i - iValuesToAdd)
         Next
     End If
    ctr = Lbound( valuesToAdd )
'--- Now add the new values starting at iBegin
    For i = iBegin To iBegin + iValuesToAdd - 1
         newVal(i) = Cstr( valuesToAdd(ctr) )
         ctr = ctr + 1
    Next
    AddValues = newVal
End Function


Public Function RemoveEntries( ValuesToRemove, arrayToRemoveFrom, compMethod As Integer ) As Variant
'=== Removes entries from arrayToRemoveFrom whos value is in the ValuesToRemove array
'=== Returns a variant that contains an array value
'=== ValuesToRemove and arrayToRemoveFrom can be either a Variant that contains an array
'=== or an Array ( this is the reason there is no data type defined )
'=== compMethod is used as defined in the StrCompare function;
' A number designating the comparison method. Use 0 for case-sensitive and pitch-sensitive,
' 1 for case-insensitive and pitch-sensitive, 4 for case-sensitive and pitch-insensitive,
' 5 for case-insensitive and pitch-insensitive. Use 2 to specify string comparison in
' the platform's collation sequence. If 2 is specified, strings are compared bit-wise.
' ... see help for details
   
    If Not Isarray( arrayToRemoveFrom ) Then Exit Function
   
'--- Store this return value in a variant to it can be converted into an array
    Dim IndexList As Variant
   
    Dim newList As Variant
    Dim i As Integer
    Dim checkList List As Integer
    Dim ctr As Long
    Dim lowVal As Integer, highVal As Integer
    Dim numToRemove As Integer
    Dim foundFlag As Integer
   
    lowVal = Lbound( arrayToRemoveFrom )
    highVal = Ubound( arrayToRemoveFrom )
   
'--- Initialize array, we are about to use Redim preserve to incrment array size
    Redim newList( 0 )
   
'--- Loop through entries
    ctr = 0
    For i = lowVal To highVal
'--- If this index position is not in the checkList then
         foundFlag = False
'--- Loop through vals to remove and if there is a match flag it
         Forall aValueToRemove In ValuesToRemove
              If Strcompare( aValueToRemove, arrayToRemoveFrom( i ), compMethod ) = 0 Then
                   foundFlag = True
                    Exit Forall
              End If
         End Forall
'--- If not found in list of entries to remove, then add to new array
         If Not foundFlag Then
'--- Increment array, preserving existing value
              Redim Preserve newList( ctr )
'--- Set value to current value
              newList( ctr ) = arrayToRemoveFrom( i )
'--- increment counter for next time 'round
              ctr = ctr + 1
         End If
    Next
   
'--- Return value
    RemoveEntries = newList
End Function