Command$ extraer archivos.

[raul338]

Código (vb) [Seleccionar] Expandir


' Mr Frog Mod Raul338 - Le cambie la RegExp
Public Function GetFiles(ByVal strText As String) As Collection
Dim cTemp                       As New Collection
Dim oRegExp                     As Object
Dim oMatch                      As Object
Dim oMatches                    As Object

    Set oRegExp = CreateObject("VBScript.RegExp")

    With oRegExp
        .Pattern = "\s?(\""[\w\s:\\\.]+\""|[\w\s:\\\.]+)\s?"
        .Global = True
        .IgnoreCase = True
    End With

    Set oMatches = oRegExp.Execute(strText)

    For Each oMatch In oMatches
        cTemp.Add oMatch.SubMatches(0)
    Next

    Set GetFiles = cTemp
End Function

Private Sub Form_Load()
Dim vItem                       As Variant
Const S                         As String = "C:\Frog\Proyecto1.exe ""C:\reto 123.exe"" C:\imagen.png"
    For Each vItem In GetFiles(S)
        MsgBox vItem
    Next
End Sub


[seba123neo]

raul338 creo que sigue manteniendo las comillas.

Leandro probaste la api CommandLineToArgv ? aca te paso un ejemplo, funciona con caracteres especiales y comillas simples.

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Type MungeLong
   X As Long
   Dummy As Integer
End Type

Private Type MungeInt
   XLo As Integer
   XHi As Integer
   Dummy As Integer
End Type

Private Declare Function CommandLineToArgv Lib "shell32" Alias "CommandLineToArgvW" (ByVal lpCmdLine As String, pNumArgs As Integer) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (dest As Any, src As Any, ByVal size&)
Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyW" (RetVal As Byte, ByVal Ptr As Long) As Long
Private Declare Function PtrToInt Lib "kernel32" Alias "lstrcpynW" (RetVal As Any, ByVal Ptr As Long, ByVal nCharCount As Long) As Long
Private Declare Function StrLen Lib "kernel32" Alias "lstrlenW" (ByVal Ptr As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
   
Private Sub Form_Load()
    Dim sarCommand() As String, lngA As Long
   
    sarCommand = ParseCommandLine
   
    For lngA = 0 To UBound(sarCommand)
        MsgBox sarCommand(lngA)
    Next lngA
End Sub

Public Function ParseCommandLine() As String()
   Dim sCommandLineW As String
   Dim BufPtr As Long
   Dim lNumArgs As Integer
   Dim i As Long
   Dim lRes As Long
   Dim TempPtr As MungeLong
   Dim TempStr As MungeInt
   Dim ArgArray(512) As Byte
   Dim Arg As String
   Dim Args() As String

   sCommandLineW = StrConv("C:\Proyecto1.exe ""C:\reto 123.exe"" C:\imagen.png archivo.txt aaa.txt aadada#&%''.txt", vbUnicode)
   BufPtr = CommandLineToArgv(sCommandLineW, lNumArgs)
   ReDim Args(lNumArgs - 1)

   For i = 1 To lNumArgs
       lRes = PtrToInt(TempStr.XLo, BufPtr + (i - 1) * 4, 2)
       lRes = PtrToInt(TempStr.XHi, BufPtr + (i - 1) * 4 + 2, 2)
       LSet TempPtr = TempStr
       lRes = PtrToStr(ArgArray(0), TempPtr.X)
       Arg = Left(ArgArray, StrLen(TempPtr.X))
       Args(i - 1) = Arg
   Next i

   Call GlobalFree(BufPtr)
   ParseCommandLine = Args
End Function

Public Function IsEmptyArray(TestArray As Variant) As Boolean
   Dim lTemp As Long
   On Error GoTo ErrHandler
   lTemp = LBound(TestArray)
   IsEmptyArray = False
   Exit Function
ErrHandler:
   IsEmptyArray = True
End Function

saludos.

[LeandroA]

Muy bueno seba123neo  tampoco tenia en cuenta los caracteres especiales. la de Raul funciona pero lo limita los caracteres especiales.

Muchisimas gracias a todos.

[ignorantev1.1]

No me doy por vencido!  

Código (vb) [Seleccionar] Expandir

Sub getFiles(ByVal args As String, res() As String)
    Dim i As Integer
    Dim e As Integer
    Dim sTmp As String

    i = InStr(args, Chr$(34))
    e = InStr(i + 1, args, Chr$(34))
    While i > 0 And e > 0
        sTmp = Mid(args, i, e - i + 1)
        args = Replace(args, sTmp, Replace(Mid(sTmp, 2, Len(sTmp) - 2), " ", "|") & ":")
        i = InStr(e, args, Chr$(34))
        e = InStr(i + 1, args, Chr$(34))
    Wend
    If Len(args) = 0 Then args = ":"
    args = Replace$(args, "  ", "")
    args = Replace$(args, " ", ":")
    args = Replace$(args, "::", ":")
    If Mid$(args, Len(args), 1) = ":" Then args = Mid$(args, 1, Len(args) - 1)
    args = Replace$(args, "|", " ")
    res = Split(args, ":")
End Sub


[BlackZeroX]

.

Otra forma...

Código (vb) [Seleccionar] Expandir



Option Explicit

Private Sub Form_Load()
Dim v$()
Dim int_i%
    For int_i% = 0 To GetArgs(InputBox("", "", ""), v$())
        Debug.Print v$(int_i%)
    Next
End Sub

Public Function GetArgs(ByRef cmd$, ByRef Args$()) As Integer
Dim lng_ptr&(2)
Dim lng_str&
Dim lng_i&
Dim byt_asc As Byte
   
    lng_str& = Len(cmd$)
    GetArgs% = -1
   
    For lng_i& = 1 To lng_str&
   
        lng_ptr&(0) = InStr(lng_i&, cmd$, Chr(32), vbBinaryCompare)
        lng_ptr&(1) = InStr(lng_i&, cmd$, Chr(34), vbBinaryCompare)
       
        If Not lng_ptr&(0) + 1 = lng_ptr&(1) Then
            If lng_ptr&(0) < lng_ptr&(1) Or lng_ptr&(1) = 0 And Not lng_ptr&(0) = 0 Then
                lng_i& = lng_ptr&(0) + 1
                byt_asc = 32
            ElseIf lng_ptr&(1) < lng_ptr&(0) Or lng_ptr&(0) = 0 And Not lng_ptr&(1) = 0 Then
                lng_i& = lng_ptr&(1) + 1
                byt_asc = 34
            Else
                Exit For
            End If
           
            lng_ptr(2) = InStr(lng_i&, cmd$, Chr(byt_asc), vbBinaryCompare)
           
            If Not lng_ptr(2) = lng_i& - 1 Then
                GetArgs% = GetArgs% + 1
                ReDim Preserve Args(0 To GetArgs%)
               
                If lng_ptr(2) > lng_i& Then
                    Args$(GetArgs%) = Mid$(cmd$, lng_i&, lng_ptr&(2) - lng_i&)
                    If byt_asc = 32 Then lng_ptr&(2) = lng_ptr&(2) - 1
                    lng_i& = lng_ptr&(2)
                Else
                    Args$(GetArgs%) = Mid$(cmd$, lng_i&)
                    Exit For
                End If
            End If
        End If
    Next
   
End Function



Ducles Lunas!¡.