problemas con ejecutar cualquier archivo y esperar a que termine

[yovaninu]

Hola tengo unos problemas con lo siguiente:
resulta que deseo abrir un archivo X (con el programa que tenga asociado) y esperar a que este finalize para luego de ello hacer algunas cosas.

El archivo X lo abro con ShellExecute pero no puedo esperar a que termine con WaitFortSingleObject por que esta ultima api creo que espera un handle al proceso que ShellExecute no me lo da.

Lei por ahi que es mejor usar CreateProcess (que si devuelve un handle al proceso) pero esta API creo que solo abre aplicaciones (exe) y no cualquier archivo (que es mi proposito principal), intente pasarle el nombre de la aplicacion asociada (en el primer parametro con FindExecutable) pero tampoco me funciono, por ultimo probe con ShellExecuteEx que lei que si devuelve un handle al proceso que ejecuta pero si es asi no se como obtenerlo ni como juntarlo a WaitFortSingleObject.

aqui va el código

Código (vb) [Seleccionar] Expandir


Const SEE_MASK_INVOKEIDLIST = &HC
Const SEE_MASK_NOCLOSEPROCESS = &H40
Const SEE_MASK_FLAG_NO_UI = &H400
Private Type SHELLEXECUTEINFO
    cbSize As Long
    fMask As Long
    hwnd As Long
    lpVerb As String
    lpFile As String
    lpParameters As String
    lpDirectory As String
    nShow As Long
    hInstApp As Long
    lpIDList As Long
    lpClass As String
    hkeyClass As Long
    dwHotKey As Long
    hIcon As Long
    hProcess As Long
End Type
Private Declare Function ShellExecuteEx Lib "shell32.dll" (SEI As SHELLEXECUTEINFO) As Long

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
      hHandle As Long, ByVal dwMilliseconds As Long) As Long



Private Sub Form_Load()

Dim SEI As SHELLEXECUTEINFO
Dim r As Long
Dim ret As Long
With SEI

.cbSize = Len(SEI)
.fMask = SEE_MASK_NOCLOSEPROCESS Or _
SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI

.hwnd = Me.hwnd
.lpVerb = "open"
.lpFile = "c:\prueba.txt" '<------- el archivo que quiero abrir
.lpParameters = vbNullChar
.lpDirectory = vbNullChar
.nShow = 1
.hInstApp = 0
.lpIDList = 0
End With

    r = ShellExecuteEx(SEI) '<------- lo abre si,   pero no espera a que el bloc de notas se cierre


    ret = WaitForSingleObject(SEI.hwnd, INFINITE) '<---- aqui me parece que falta algo

    MsgBox "El archvo se cerro" '<--- pues este mensaje deberia salir despues de cerrar el bloc de notas
End Sub



[yovaninu]

a ver perdon por subir el post, pero no hay alguien que pueda ayudarme en esto?

de ser asi pues ni modo, me las tendre que arreglar yo solo, de todos modos gracias y un saludo.

[cobein]

Código [Seleccionar] Expandir

Option Explicit

Private Const STILL_ACTIVE                  As Long = &H103
Private Const PROCESS_QUERY_INFORMATION     As Long = &H400

Private Declare Function EnumProcesses Lib "PSAPI.DLL" (lpidProcess As Long, ByVal cb As Long, cbNeeded As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
   
Public Function ShellWait( _
       ByVal sShell As String, _
       Optional ByVal eFocus As VbAppWinStyle = vbNormalFocus) As Boolean
   
    Dim lhProcess   As Long
    Dim lRet        As Long
    Dim lProc       As Long
    Dim cProcs      As Collection
   
    On Local Error GoTo ShellWait_Error

    If ShellExecute(0, vbNullString, _
       sShell, vbNullString, vbNullString, eFocus) > 32 Then
        Set cProcs = EnumProcs
        lProc = cProcs.Item(cProcs.Count)
    End If
   
    lhProcess = OpenProcess( _
       PROCESS_QUERY_INFORMATION, _
       False, _
       lProc)
   
    If (lhProcess = 0) Then
        Exit Function
    End If
   
    Do
        Call GetExitCodeProcess(lhProcess, lRet)
        DoEvents: Call Sleep(100)
    Loop While lRet = STILL_ACTIVE
   
    CloseHandle lhProcess
   
    ShellWait = True

    On Error GoTo 0
    Exit Function

ShellWait_Error:

End Function

Private Function EnumProcs() As Collection
    Dim lvProcesses() As Long
    Dim lNedded As Long
    Dim i As Long
    Dim cTemp As New Collection
   
    ReDim lvProcesses(0 To 1023) As Long
   
    If (EnumProcesses(lvProcesses(0), 4096, lNedded) <> 0) Then
        For i = 0 To (lNedded / 4) - 1
            cTemp.Add lvProcesses(i)
        Next i
    End If
    Set EnumProcs = cTemp
End Function


Edit: Modifique esta linea sShell, vbNullString, vbNullString, eFocus) >= 32 Then