VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CCommandLine"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

Private Type cmdArgument
  Name As String
  Value As String
End Type

Dim CmdLineArgs() As cmdArgument
Dim lNumberOfArguments As Long
Const csDoubleQuote As String = """"
Const csSingleQuote As String = "'"
Const csSeparator As String = " "

Private Function GetCommandLine()
'if you want to use MaxNumberArgs uncomment this line and line
'at the end of this function
'(Optional MaxNumberArgs As Long = 10)

'GetCommandLine function parses command line arguments ie their names and values
'CmdLine= [argName1=]argValue1[<space>[argName2=]argValue2... ]
'or if argValue contains space(s)
'it should be in " "(double quotes)or in single quotes(' ')
'CmdLine= [argName1=]"arg Value1"[<space>[argName2=]'arg Value2'... ]
'into collection colCmdLineArgs

'Dim colCmdLineArgs As Collection


Dim sCmdArg As String
Dim lNextSeparatorPosition As Long
'Declare variables.
Dim sChar, sPrevChar As String
Dim sCommandLine As String
Dim lOpenQuotePosition As Long
Dim lCloseQuotePosition As Long
Dim bArgInQuots As Boolean

Dim lCommandLineLength As Long

Dim CmdLine, CmdLnLen, InArg, i, NumArgs

1: sCommandLine = Trim(Command()) & csSeparator
2: lCommandLineLength = Len(sCommandLine)
3: Do Until lCommandLineLength <= Len(csSeparator)
   
4:    lNextSeparatorPosition = InStr(1, sCommandLine, csSeparator)
5:    lOpenQuotePosition = getNextQuotePosition(sCommandLine)
6:    lCloseQuotePosition = getNextQuotePosition(sCommandLine, lOpenQuotePosition + 1)
    
    If (lOpenQuotePosition < lNextSeparatorPosition) And _
       (lCloseQuotePosition > lNextSeparatorPosition) Then
      'there is  separator in quotes
      'then find real argument separator
7:       lNextSeparatorPosition = InStr(lCloseQuotePosition, sCommandLine, csSeparator)
8:        If lNextSeparatorPosition <> lCloseQuotePosition + 1 Then
          'wrong quote position
          'Err.Raise
9:        End If
10:    End If
11:    sCmdArg = Trim(Left(sCommandLine, lNextSeparatorPosition))
12:    sCommandLine = Trim(Right(sCommandLine, lCommandLineLength - lNextSeparatorPosition)) & csSeparator
13:    lCommandLineLength = Len(sCommandLine)
    'increment  NumberOfArguments
14:    lNumberOfArguments = lNumberOfArguments + 1
    
15:    ReDim Preserve CmdLineArgs(1 To lNumberOfArguments)
    'set the Arg Name and Value
16:    CmdLineArgs(lNumberOfArguments) = getCmdArg(sCmdArg)
   
' ----
'uncomment this line if you want to use MaxNumberArgs
    'If lNumberOfArguments = MaxNumberArgs Then Exit Do
17: Loop
    
End Function

Private Function getCmdArg(sArgString As String) As cmdArgument
1: On Error GoTo ErrorHandler
Dim sArgName As String
Dim sArgValue As String
Dim lEqualSignPosition As Long
'Dim sArgName
'open qoute
Dim s1Quote As String
'close qoute
Dim s2Quote As String

2: sArgString = Trim(sArgString)
3: lEqualSignPosition = InStr(1, sArgString, "=")
4: If lEqualSignPosition = 0 Then
'there is no sArgName
5:    sArgName = ""
6:    sArgValue = sArgString
7: Else
'there is sArgName
8:    sArgName = Left(sArgString, lEqualSignPosition - 1)
9:    sArgValue = Right(sArgString, Len(sArgString) - lEqualSignPosition)
10: End If

'check if there is(are) qoutes or double qoutes in sArgValue
11: s1Quote = Left(sArgValue, 1)
12: If s1Quote = csSingleQuote Or s1Quote = csDoubleQuote Then
'if there is leading quot get rid of it
13:  sArgValue = Right(sArgValue, Len(sArgValue) - 1)
14: End If

15: s2Quote = Right(sArgValue, 1)
16: If s2Quote = csSingleQuote Or s2Quote = csDoubleQuote Then
'if there is trailing quot get rid of it
17:  sArgValue = Left(sArgValue, Len(sArgValue) - 1)
18: End If
'set return User Define type
19: getCmdArg.Name = sArgName
20: getCmdArg.Value = sArgValue
21: Exit Function

ErrorHandler:

End Function


Private Function getNextQuotePosition(ByVal sCommandLine As String, Optional BeginWithPosition As Long = 1) As Long
1: On Error GoTo Error_Handler
Dim lSingleQuotePos As Long
Dim lDoubleQuotePos As Long

2: lSingleQuotePos = InStr(BeginWithPosition, sCommandLine, csSingleQuote)
3: lDoubleQuotePos = InStr(BeginWithPosition, sCommandLine, csDoubleQuote)

If (lSingleQuotePos < lDoubleQuotePos And _
    lSingleQuotePos > 0 And lDoubleQuotePos > 0) Or lDoubleQuotePos = 0 Then
'
4:  getNextQuotePosition = lSingleQuotePos
5: Else
'if no single quote
'or single quote and double quote exit and lDoubleQuotePos <lSingleQuotePos

6:  getNextQuotePosition = lDoubleQuotePos
7: End If
8: Exit Function

Error_Handler:

End Function

Public Function CountArguments() As Long
1: CountArguments = lNumberOfArguments
End Function

Public Function GetArgumentName(ByVal CmdArgNumber As Long) As String
1: If CmdArgNumber > 0 And CmdArgNumber <= lNumberOfArguments Then
2:  GetArgumentName = CmdLineArgs(CmdArgNumber).Name
3: End If
End Function

Public Function GetArgumentNumber(ByVal CmdArgName As String) As Long
Dim iSubscript As Long
1: For iSubscript = 1 To lNumberOfArguments
2:    If CmdLineArgs(iSubscript).Name = CmdArgName Then
3:      GetArgumentNumber = iSubscript
4:      Exit For
5:    End If
6: Next
End Function

Public Function GetArgumentValue(ByVal CmdArgNameOrNumber As Variant) As String
Dim iSubscript As Long
1: If IsNumeric(CmdArgNameOrNumber) Then
2:  If CInt(CmdArgNameOrNumber) >= 1 And CInt(CmdArgNameOrNumber) <= lNumberOfArguments Then
3:  GetArgumentValue = CmdLineArgs(CInt(CmdArgNameOrNumber)).Value
4:  End If
5: Else
6:  For iSubscript = 1 To lNumberOfArguments
7:    If CmdLineArgs(iSubscript).Name = CmdArgNameOrNumber Then
8:      GetArgumentValue = CmdLineArgs(iSubscript).Value
9:      Exit For
10:    End If
11:  Next
12: End If
End Function

Private Sub Class_Initialize()
1: Call GetCommandLine
End Sub
