Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/parsed/parse.bas

BASIC Source File | 1995-05-09 | 7.0 KB | 230 lines

Option Explicit

'form show
Global Const MODAL = 1

'msgbox
Global Const MB_ICONINFORMATION = 64

'mousePointer
Global Const DEFAULT = 0
Global Const HOURGLASS = 11

'WindowState
Global Const NORMAL = 0    ' 0 - Normal
Global Const MINIMIZED = 1 ' 1 - Minimized
Global Const MAXIMIZED = 2 ' 2 - Maximized

'clipboard object
Global Const CF_TEXT = 1

Sub EndProg ()
   Dim c%

   For c% = Forms.Count - 1 To 0 Step -1
      Unload Forms(c%)
   Next c%
   End

End Sub

'load selected text file and return the contents
'in a string variable
Function LoadFile$ (TheFile$, FileLength&)
   'string var containing file text
   Dim FileStr$
   Dim FNum%

   FNum% = FreeFile

   Open TheFile$ For Input As #FNum

   FileStr$ = Input$(FileLength&, #FNum)

   Close #FNum

   LoadFile$ = FileStr$

End Function

'Program startup
Sub Main ()
   ChDir App.Path
   frmParse.Show
End Sub

'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.  See NOTE: below.
'
Function ParseAndFillArray1% (TheString$, Delim$, DynArray$())
   Dim ElementCt%, CurPos%, LenAssigned%, CurStrLen%, LenDelim%

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

   CurStrLen% = Len(TheString$)

   Do
      'allocate the array element
      ReDim Preserve DynArray$(1 To ElementCt%)
      'get the current segment (not including delimiter)
      CurStrLen% = (InStr(CurPos%, TheString$, Delim$) - CurPos%)
      If CurStrLen% < 0 Then
      'if delimiter not found
     'we have the last segment
     'assign the value to array (the last, righthand part)
     DynArray$(ElementCt%) = Right$(TheString$, (Len(TheString$) - (LenAssigned% - 1)))
     'done
     Exit Do
      Else
     'assign the value to array
      DynArray$(ElementCt%) = Mid$(TheString$, CurPos%, CurStrLen%)
      End If
      '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%
      'increment array index for next element
      ElementCt% = ElementCt% + 1
   Loop

   'return # elements - NOTE: If the passed string ends in the delimiter,
   'the last element in the array will be the empty string
   'If this is the case, subtract 1 from the number returned
   If DynArray$(ElementCt%) = "" Then
      ParseAndFillArray1% = ElementCt% - 1
   Else
      ParseAndFillArray1% = ElementCt%
      'or ParseAndFillArray1% = UBound(DynArray$)
   End If
End Function

'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.  See NOTE: below.
'
'
Function ParseAndFillArray2% (TheString$, Delim$, DynArray$(), SetReDim%)
   Dim ElementCt%, CurPos%, LenAssigned%, CurStrLen%, LenDelim%

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

   CurStrLen% = Len(TheString$)

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

   Do
      If ElementCt% Mod SetReDim% = 0 Then
     ReDim Preserve DynArray$(1 To ElementCt% + SetReDim%)
      End If
      'get the current segment (not including delimiter)
      CurStrLen% = (InStr(CurPos%, TheString$, Delim$) - CurPos%)
      If CurStrLen% < 0 Then
      'if delimiter not found
     'we have the last segment
     'assign the value to array (the last, righthand part)
     DynArray$(ElementCt%) = Right$(TheString$, (Len(TheString$) - (LenAssigned% - 1)))
     'done
     Exit Do
      Else
     'assign the value to array
      DynArray$(ElementCt%) = Mid$(TheString$, CurPos%, CurStrLen%)
      End If
      '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%
      'increment array index for next element
      ElementCt% = ElementCt% + 1
   Loop

   'return # elements - NOTE: If the passed string ends in the delimiter,
   'the last element in the array will be the empty string
   'If this is the case, subtract 1 from the number returned
   If DynArray$(ElementCt%) = "" Then
      ParseAndFillArray2% = ElementCt% - 1
   Else
      ParseAndFillArray2% = ElementCt%
   End If
End Function

'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