' #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