Una forma es interactuar con la API de Windows: CreateProcessA()
para inicial la ejecución de un determinado proceso, puede ser de consola o gráfico, luego para esperar la finalización del comando, hay que usar WaitForSingleObject()
para verificar si el proceso está activo y si es así esperarlo. En caso de querer implementar un "timeout" para el comando, habrá que implementar un timer para controlar el tiempo y usar TerminateProcess()
para finalizarlo.
Una implementación sencilla podría ser la siguiente:
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadID As Long
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Public Function Execute(Path As String, Optional Parameters As String = "", Optional Wait As Boolean = False, Optional Hide As Boolean = False, Optional TimeOut As Integer = -1) As Long
Const STARTF_USESHOWWINDOW As Long = &H1
Const SW_HIDE As Long = 0
Dim proc As PROCESS_INFORMATION
Dim startup As STARTUPINFO
Dim Ret As Long
Dim CmdLine As String
Dim ExecuteTask As Long
Dim elapsed_time As Double
CmdLine = Path
If Trim(Parameters) <> "" Then
CmdLine = CmdLine & " """ & Parameters & """"
End If
startup.cb = Len(startup)
If Hide Then
startup.dwFlags = STARTF_USESHOWWINDOW
startup.wShowWindow = SW_HIDE
End If
start_time = Timer
Ret = CreateProcessA(0&, CmdLine, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, startup, proc)
ExecuteTask = proc.hProcess
If Wait Then
elapsed_time = Timer - start_time
While IsTaskRunning(ExecuteTask) And (TimeOut <= 0 Or elapsed_time < TimeOut)
DoEvents
elapsed_time = Timer - start_time
Wend
If IsTaskRunning(ExecuteTask) Then
TerminateProcess ExecuteTask, -1&
End If
End If
End Function
Public Function IsTaskRunning(taskID As Long) As Boolean
Dim Ret As Long
If taskID = 0 Then Exit Function
Ret = WaitForSingleObject(taskID, 0)
IsTaskRunning = (Ret <> 0)
If Not IsTaskRunning Then
Ret = CloseHandle(taskID)
taskID = 0
End If
End Function
Para probar la nueva rutina Execute()
, invocando a la línea de comando como proceso podemos hacer lo siguiente:
Private Sub Command1_Click()
Execute "cmd.exe", , True, , 10 ' Ejecución con timeout de 10 segundos
Execute "cmd.exe", , True ' Ejecución con espera
MsgBox "Fin de la ejecución"
End Sub