Título: problemas con ejecutar cualquier archivo y esperar a que termine
Publicado por: yovaninu en 24 Marzo 2008, 15:56 pm
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 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
Título: Re: problemas con ejecutar cualquier archivo y esperar a que termine
Publicado por: yovaninu en 25 Marzo 2008, 05:09 am
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.
Título: Re: problemas con ejecutar cualquier archivo y esperar a que termine
Publicado por: cobein en 25 Marzo 2008, 15:07 pm
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
|