' #VBIDEUtils#************************************************************
' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : [email protected]
' * Date             : 24/09/98
' * Time             : 14:15
' * Module Name      : class_CommandLineParser
' * Module Filename  : CommandLine.cls
' **********************************************************************
' * Comments         : COMMAND LINE interpreter
' *
' * analyzes command line into arguments, switches, and switch values
' *** e.g. given command line
' *** << myprog myfile.txt /user="Thierry Waty" /password=Julie >>
' ***
' ***  the global object will support the following:
' *** goArgv.Args.Count = 1
' *** goArgv.Switches.Count = 2
' *** goArgv.Args!arg1 = "myfile.txt"
' *** If goArgv.SwitchUsed("Debugmode") Then ....
' *** goArgv.Switches!Username = "Thierry Waty"
' *** goArgv.Switches("password") = "Julie" OR
' *** goArgv.Switches!password = "Julie"
' ***
' *** NOTES:
' *** 1) Limited support for unix style switches
' ***  << myprog myfile.txt -u"Thierry Waty" -pJulie >>
' *** will give the same results as above, except the switch is always
' *** one Character
' ***  goArgv.Switches!u = "Thierry Waty"
' ***  goArgv.Switches!p = "Julie"
' *** 2) Can't distinguish case for the options: X is the same as x, User is the same as user
' *
' *
' **********************************************************************

Option Explicit

Public Args       As Collection
Public Switches   As Collection
Private mcolPairs As Collection 'raw switch pairs before parsed, hold the option/value pairs
Private mcolKeys  As Collection 'keys of switch pairs

Private Sub Class_Initialize()

   ' *** creates the collection when this class is created
   Dim strCommand As String

   Set Switches = New Collection
   Set mcolKeys = New Collection
   Set mcolPairs = New Collection
   Set Args = New Collection

   strCommand = Trim$(Command)
   If Len(strCommand) = 0 Then Exit Sub
   Call StuffAll(strCommand)

End Sub

Private Sub Class_Terminate()

   ' *** destroys collection when this class is terminated
   Set Switches = Nothing
   Set Args = Nothing
   Set mcolPairs = Nothing
   Set mcolKeys = Nothing

End Sub

Private Sub ParseAndAddSwitch(rstrWorkArgs As Variant)

   'input: entire option value string come in here, variant so
   '     caller can    use "for each"
   'output: parse and stuff option and value separately in the
   '     member collections

   Dim intMarker     As Integer
   Dim intSwitchPos  As Integer
   Dim strKey        As String
   Dim strWork       As String
   Dim strItem       As String
   Dim colParts      As Collection

   If Left$(rstrWorkArgs, 1) = "-" Then 'unix style
      strWork = Mid$(rstrWorkArgs, 2) 'item for stripQuotes

      If Left$(strWork, 1) = " " Then 'bad unix format, s/b a character here
         Err.Raise 41001, TypeName(Me), "Bad UNIX command line format, space after switch symbol"
      End If

      strItem = StripQuotes(Mid$(strWork, 2))
      strKey = Mid(rstrWorkArgs, 2, 1)
      Call Switches.Add(Item:=strItem, Key:=strKey)
      Call mcolKeys.Add(Item:=strKey)
   Else 'dos/vms style

      Call ParseSwitch(rstrWorkArgs)

   End If

End Sub

Private Function StripQuotes(rstrIn As String) As String

   Dim strWork As String

   strWork = Trim$(rstrIn)

   If Left$(strWork, 1) <> """" Then 'not a quoted string
      StripQuotes = strWork
   ElseIf Right$(strWork, 1) <> """" Then 'error no terminating quote
      Err.Raise 41003, TypeName(Me), "Bad DOS/VMS command line format, no terminating quote"
   Else
      StripQuotes = Mid$(strWork, 2, Len(strWork) - 2)
   End If

End Function

Private Sub StuffAll(rstrCommand As String)

   'rstrCommand is a working string, gets the chop shop treatment

   Dim strWorkArg As Variant 'working argument holder
   Dim lngEnd     As Long
   Dim lngStart   As Long
   Dim strStyle   As String

   Set mcolPairs = CommandToStringArray(rstrCommand)

   For Each strWorkArg In mcolPairs

      If Left$(strWorkArg, 1) = "-" Then 'unix style switch
         Call ParseAndAddSwitch(strWorkArg)
      ElseIf Left$(strWorkArg, 1) = "/" Then 'dos/vms style switch
         Call ParseAndAddSwitch(strWorkArg)
      Else 'regular argument
         Args.Add strWorkArg, "arg" & Args.Count + 1
      End If

   Next strWorkArg
End Sub

Public Function CommandToStringArray(rstrInline As String) As Collection
   ' *** input: command line as a string
   ' *** Takes input of a string containing 0+ spaces and 0+ quotes
   ' *** spaces normally delimit substrings, except
   ' *** quotes are used to protect spaces from parsing, and are cant
   ' *** be part of the substring
   ' *** returns collection of strings in a variant
   Dim intPos        As Integer
   Dim intLen        As Integer
   Dim blnInQuotes   As Boolean
   Dim strCurrent    As String
   Dim strChar       As String
   Dim col           As New Collection
   Dim i             As Integer
   'iterate over string looking for space delimiters NOT within quotes
   strCurrent = ""
   intLen = Len(rstrInline)
   For i = 1 To intLen
      strChar = Mid$(rstrInline, i, 1)

      If strChar = """" Then
         blnInQuotes = Not blnInQuotes
      ElseIf (strChar = " " And Not blnInQuotes) Then
         col.Add strCurrent
         strCurrent = ""
      Else
         strCurrent = strCurrent & strChar
      End If

   Next i 'over each input string character
   If Not strCurrent = "" Then
      col.Add strCurrent
   End If

   Set CommandToStringArray = col

End Function

Public Property Get SwitchUsed(strOption As String) As Boolean
   ' *** answers the question: was this option used on the command line
   ' *** never mind the value supplied, if any

   SwitchUsed = ItemInArray(strOption, mcolKeys, False)

End Property

Private Function ItemInArray(InputItem As Variant, InputArray As Variant, Optional CaseSensitive) As Boolean
   ' *** default for CaseSensitive = False

   Dim strInputItem As String
   Dim strArrayItem As String
   Dim vntLoopItem As Variant
   If IsMissing(CaseSensitive) Then
      CaseSensitive = False
   End If
   If CaseSensitive = True Then
      strInputItem = InputItem
   Else
      strInputItem = UCase$(InputItem)
   End If

   ItemInArray = False 'reset before we look
   For Each vntLoopItem In InputArray

      If CaseSensitive = True Then
         strArrayItem = vntLoopItem
      Else
         strArrayItem = UCase$(vntLoopItem)
      End If


      If strArrayItem = strInputItem Then
         ItemInArray = True
         Exit For
      End If
   Next

End Function

Public Sub ParseSwitch(rstrSwitchPair As Variant)
   'input: dos style switch/option pair separated by = sign, poss
   '     with quotes
   ' ***  variant so caller can use "for each"
   ' *** string containing characters, 0+ spaces and 0+ quotes
   ' *** output: returns collection of strings in a variant
   ' *** quotes are used to protect spaces from parsing, they are not
   ' *** part of the substring
   
   Dim intPos        As Integer
   Dim intLen        As Integer
   Dim blnInQuotes   As Boolean
   Dim strCurrent    As String
   Dim strKey        As String
   Dim strChar       As String
   Dim col           As New Collection
   Dim i             As Integer
   
   'iterate over string looking for equal sign NOT within quotes
   strCurrent = ""
   intLen = Len(rstrSwitchPair)
   For i = 1 To intLen
      strChar = Mid$(rstrSwitchPair, i, 1)

      If strChar = """" Then
         blnInQuotes = Not blnInQuotes
      ElseIf (strChar = "=" And Not blnInQuotes) Then 'preceding is the Key
         strKey = Mid$(strCurrent, 2)
         strCurrent = ""
      Else
         strCurrent = strCurrent & strChar
      End If

   Next 'over each input string character
   ' *** NOTE: the option value can be the empty string
   If strKey = "" Then 'there was no switch value, the string is the Switch alone
      Call Switches.Add("", Mid$(strCurrent, 2))
      Call mcolKeys.Add(Mid$(strCurrent, 2)) 'trim the "/"
   Else 'a typical switch /value pair
      Call Switches.Add(strCurrent, strKey)
      Call mcolKeys.Add(strKey)
   End If

End Sub

This is a command line parsing routine I found online.  Original comments left in tact.

class_CommandLineParser

command, line

Visual Basic