Как отпарсить командную строку , CommandLineToArgvW

Вам никогда не приходило в голову написать свой парсер командной строки?
Который бы разбирал что-то типа

a b "x\"x" 555

Если приходилось то вы знаете, как это "приятно".
Однако, в windows уже есть функция, которое все распарсит сама.

Option Explicit
Private Declare Function CommandLineToArgvW Lib "shell32.dll" (ByVal nInput As Long, ByRef retcount As Long) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function SysAllocString Lib "oleaut32" (ByVal nString As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
 
Public Function CommandLineToArgvVB(ByVal nInput As String) As String()
    Dim ret As Long, retcount As Long, rt() As String, I As Integer, lng As Long
    ret = CommandLineToArgvW(StrPtr(nInput), retcount)
    If retcount > 0 Then
        ReDim rt(retcount - 1)
        For I = 0 To UBound(rt)
            CopyMemory VarPtr(lng), ret + I * 4, 4
            CopyMemory VarPtr(rt(I)), VarPtr(SysAllocString(lng)), 4
        Next
        CommandLineToArgvVB = rt
    End If
    If ret <> 0 Then LocalFree ret
End Function

Использование:

Private Sub Form_Load()
    Dim ret() As String, I As Long
    ret = CommandLineToArgvVB("a b ""xx yy"" \""abc")
    MsgBox Join(ret, vbCrLf)
    End
End Sub

у меня по-лучше будет, наверно...

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

На всякий случай: [VB 6] Парсер командной строки

Цитата Executioner @ 16.01.07, 22:58

у меня по-лучше будет, наверно...

Наверное, интересно только, чем?
Про то что в своем парсере можно чтото поменять по вкусу мне говорить не надо.

Сообщение отредактировано: ANDLL - 17.01.07, 08:12