Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/text_utl/parsed/parse.bas

BASIC Source File | 1994-10-04 | 8.8 KB | 271 lines

Option Explicit
Option Compare Text

'9/25/94 PWR
'Routine to accept a string to work on and a delimiter,
'and fill the passed dynamic array with parsed data.
'
'Parameters:
'
'TheString$ - String to parse
'Delim$ - Delimiting string (may be single or multiple characters)
'DynArray$() - An 'unredimmed' dynamic array passed by reference
'(VB's default) which is filled with the parsed data which can be
'accessed by the calling routine.
'
'Return Value: Number of elements.
'
Function ParseAndFillArray1% (TheString$, Delim$, DynArray$())
    Dim ElementCt%, CurPos%, LenAssigned%, CurStrLen%, LenDelim%

    LenDelim% = Len(Delim$)
    'initialize array element count
    ElementCt% = 0
    'starting instr pos
    CurPos% = 1
    LenAssigned% = 1

    'before going through the array, add a delimiter to the end of
    'the segment if there is not one there already
    If Right$(TheString$, LenDelim%) <> Delim$ Then
    TheString$ = TheString$ & Delim$
    End If

    Do
    'get the current segment (not including delimiter)
    CurStrLen% = InStr(CurPos%, TheString$, Delim$) - CurPos%
    'done if delimiter not found
    If CurStrLen% < 0 Then
        Exit Do
    End If
    'we have a string segment, so
    'increment array index for this element
    ElementCt% = ElementCt% + 1
    'allocate the array element
    ReDim Preserve DynArray$(1 To ElementCt%)
    'assign the value to array
    DynArray$(ElementCt%) = Mid$(TheString$, CurPos%, CurStrLen%)
    'assign start position of next element
    'add length of current string to length assigned var.
    LenAssigned% = LenAssigned% + (Len(DynArray$(ElementCt%)) + LenDelim%)
    'set the new starting position (ahead of current delimiter) for next extraction
    CurPos% = LenAssigned%
    Loop

    ParseAndFillArray1% = ElementCt%
    'or ParseAndFillArray1% = UBound(DynArray$)
End Function

'9/25/94
'Routine to accept a string to work on and a delimiter,
'and fill the passed dynamic array with parsed data.
'
'Parameters:
'
'TheString$ - String to parse
'Delim$ - Delimiting string (may be single or multiple characters)
'DynArray$() - An 'unredimmed' dynamic array passed by reference
'(VB's default) which is filled with the parsed data which can be
'accessed by the calling routine.
'SetReDim% - This is a parameter which sets the frequency of array
'resizing so performance can be optimized. This parm. is the only
'difference between this routine and ParseAndFillArray1%
'
'
'Return Value: Number of elements.
'
'
Function ParseAndFillArray2% (TheString$, Delim$, DynArray$(), SetReDim%)
    Dim ElementCt%, CurPos%, LenAssigned%, CurStrLen%, LenDelim%

    LenDelim% = Len(Delim$)
    'initialize array element count
    ElementCt% = 0
    'starting instr pos
    CurPos% = 1
    LenAssigned% = 1

    'before going through the array, add a delimiter to the end of
    'the segment if there is not one there already
    If Right$(TheString$, LenDelim%) <> Delim$ Then
    TheString$ = TheString$ & Delim$
    End If

    'do initial array alloc.
    ReDim DynArray$(1 To SetReDim%)

    Do
    'get the current segment (not including delimiter)
    CurStrLen% = InStr(CurPos%, TheString$, Delim$) - CurPos%
    If CurStrLen% < 0 Then
    'if delimiter not found
        'done
        Exit Do
    End If
    'we have a segment, so
    'increment array index for next element
    ElementCt% = ElementCt% + 1
    'allocate the array element if necessary
    If ElementCt% Mod SetReDim% = 0 Then
        ReDim Preserve DynArray$(1 To ElementCt% + SetReDim%)
    End If
    'assign the value to array
    DynArray$(ElementCt%) = Mid$(TheString$, CurPos%, CurStrLen%)
    'assign start position of next element
    'add length of current string to length assigned var.
    LenAssigned% = LenAssigned% + (Len(DynArray$(ElementCt%)) + LenDelim%)
    'set the new starting position (ahead of current delimiter) for next extraction
    CurPos% = LenAssigned%
   Loop

   'return # elements
   ParseAndFillArray2% = ElementCt%

End Function

'9/25/94
'Routine to accept a string to work on and a delimiter,
'and fill the passed listbox with parsed data.
'
'Parameters:
'
'TheString$ - String to parse
'Delim$ - Delimiting string (may be single or multiple characters)
'L - a listbox to fill with the parsed data.
'
'Return Value: Number of items in listbox.
'
Function ParseAndFillListBox% (TheString$, Delim$, L As ListBox)
    Dim ListCt%, CurPos%, LenAssigned%, CurStrLen%, LenDelim%
    Dim ret& 'needed only if SendMessage method used

    LenDelim% = Len(Delim$)
    'initialize list item count
    ListCt% = 0
    'starting instr pos
    CurPos% = 1
    LenAssigned% = 1

    'before going through the list, add a delimiter to the end of
    'the segment if there is not one there already
    If Right$(TheString$, LenDelim%) <> Delim$ Then
    TheString$ = TheString$ & Delim$
    End If

    Do
    'get the current segment (not including delimiter)
    CurStrLen% = (InStr(CurPos%, TheString$, Delim$) - CurPos%)
    'exit if no segment
    If CurStrLen% < 0 Then
        Exit Do
    End If

    'we have a segment, so increment index for next item
    ListCt% = ListCt% + 1
    'use one of following three lines of code to insert the item
    'into the listbox (keep the other two commented out)
    'ret& = SendMessageByString&(L.hWnd, LB_INSERTSTRING, -1, Mid$(TheString$, CurPos%, CurStrLen%))
    'ret& = SendMessageByString&(L.hWnd, LB_ADDSTRING, 0, Mid$(TheString$, CurPos%, CurStrLen%))
    L.AddItem Mid$(TheString$, CurPos%, CurStrLen%)

    'assign start position of next element
    'add length of current string to length assigned var.
    LenAssigned% = LenAssigned% + CurStrLen% + LenDelim%
    'set the new starting position (ahead of current delimiter) for next extraction
    CurPos% = LenAssigned%
    Loop

    'return list count
    ParseAndFillListBox% = L.ListCount

End Function

'9/25/94
'Function to process a passed string array and return
'a new string consisting of the passed array elements
'concatenated with a separator. Used in conjunction with
'ParseAndFillArray%(). If an element is an empty string
'(this will occur when there are two or more consecutive
'crlf's in the text), discard the crlf and do not add another space.
'
'Parameters:
'
'DynArray$() - An 'unredimmed' dynamic array passed by reference
'(VB's default) which is filled with the processed data which can be
'accessed by the calling routine.
'separator$ - Character to put between elements in creating the
'build string.
'AdjustedLineCt% - A value passed by reference which will return
'a line count value which does not consider single CRLF's a line.
'
'Return Value: The string constructed from the array.
'
Function ProcessArray$ (DynArray$(), Separator$, AdjustedLineCt%)
   Dim BuildStr$
   Dim i%

   'go through the array (to the second to last element)
   'adding each element to the build string plus the
   'separator. Elements consisting of an empty string are
   'bypassed.
   For i% = 1 To UBound(DynArray$) - 1
      If DynArray(i%) <> "" Then
     BuildStr$ = BuildStr$ & DynArray(i%) & Separator$
     'increment adjusted linecount
     AdjustedLineCt% = AdjustedLineCt% + 1
      End If
   Next i%

   'add the last element - do not append separator
   BuildStr$ = BuildStr$ & DynArray$(UBound(DynArray$))
   'increment adjusted linecount
   AdjustedLineCt% = AdjustedLineCt% + 1

   'return the built string
   ProcessArray$ = BuildStr$
End Function

'9/25/94
'Function to process a passed listbox and return
'a new string consisting of the passed listbox items
'concatenated with a separator. Used in conjunction with
'ParseAndFillListBox%(). If an item is an empty string
'(this will occur when there are two or more consecutive
'crlf's in the text), discard the crlf and do not add another space.
'
'Parameters:
'
'L - A listbox to process.
'separator$ - Character to put between elements in creating the
'build string.
'AdjustedLineCt% - A value passed by reference which will return
'a line count value which does not consider single CRLF's a line.
'
'Return Value: The string constructed from the listbox.
'
Function ProcessList$ (L As ListBox, Separator$, AdjustedLineCt%)
   Dim BuildStr$
   Dim i%

   'go through the listbox (to the second to last element)
   'adding each item to the build string plus the
   'separator. Items in listbox consisting of an empty string are
   'bypassed.
   For i = 0 To L.ListCount - 2
      If L.List(i) <> "" Then
     BuildStr$ = BuildStr$ & L.List(i) & Separator$
     'increment adjusted linecount
     AdjustedLineCt% = AdjustedLineCt% + 1
      End If
   Next i

   'add the last item - do not append separator
   BuildStr$ = BuildStr$ & L.List(L.ListCount - 1)
   'increment adjusted linecount
   AdjustedLineCt% = AdjustedLineCt% + 1

   'return the built string
   ProcessList$ = BuildStr$
End Function