Esta rutina se utiliza para lanzar una aplicación desde el Shell visual basic y esperar a que la aplicación lanzada termine para continuar con la ejecución.

Para ello se utiliza la función API OpenProcess para identificar el proceso que se ha lanzado con el Shell y se espera hasta que el proceso termine para continuar la ejecución.

En un módulo creamos el siguiente código para poder utilizar las funciones de la API:

CLIC PARA VER TEXTO PLANO
Visual Basic:
  1. Option Explicit
  2. Private Declare Function OpenProcess Lib "kernel32" _
  3. (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
  4. ByVal dwProcessId As Long) As Long
  5. Private Declare Function GetExitCodeProcess Lib "kernel32" _
  6. (ByVal hProcess As Long, lpExitCode As Long) As Long
  7. Private Const STATUS_PENDING = &H103&
  8. Private Const PROCESS_QUERY_INFORMATION = &H400

Luego en el mismo módulo creamos la función:

CLIC PARA VER TEXTO PLANO
Visual Basic:
  1. Public Function ShellandWait(ExeFullPath As String, _
  2. Optional TimeOutValue As Long = 0) As Boolean
  3.     Dim lInst As Long
  4.     Dim lStart As Long
  5.     Dim lTimeToQuit As Long
  6.     Dim sExeName As String
  7.     Dim lProcessId As Long
  8.     Dim lExitCode As Long
  9.     Dim bPastMidnight As Boolean
  10.     On Error GoTo ErrorHandler
  11.     lStart = CLng(Timer)
  12.     sExeName = ExeFullPath
  13.     'Deal with timeout being reset at Midnight
  14.     If TimeOutValue> 0 Then
  15.         If lStart + TimeOutValue <86400 Then
  16.             lTimeToQuit = lStart + TimeOutValue
  17.         Else
  18.             lTimeToQuit = (lStart - 86400) + TimeOutValue
  19.             bPastMidnight = True
  20.         End If
  21.     End If
  22.     lInst = Shell(sExeName, vbMinimizedNoFocus)
  23. lProcessId = OpenProcess(PROCESS_QUERY_INFORMATION, False, lInst) 'Optenemos el ProcessID
  24.     Do  'Aqui se genera un ciclo hasta que el proceso sea distinto de pendiente, o sea, Alla terminado.
  25.         Call GetExitCodeProcess(lProcessId, lExitCode) ' Optenemos el si hay exits code o todavia esta en ejecucion (pending)
  26.         DoEvents
  27.         If TimeOutValue And Timer> lTimeToQuit Then
  28.             If bPastMidnight Then
  29.                  If Timer <lStart Then Exit Do
  30.             Else
  31.                  Exit Do ' Se sale del ciclo si se acavo el tiemo de espera
  32.             End If
  33.     End If
  34.     Loop While lExitCode = STATUS_PENDING
  35.     ShellandWait = True
  36. ErrorHandler:
  37. ShellandWait = False
  38. Exit Function
  39. End Function

Y luego llamar a la función. La podemos llamar de dos formas, con el valor opcional o sin el:

ShellandWait (text1.text,0) - espera infinitamente hasta que termine el proceso.

ShellandWait (text1.text,10000) - espera 10 seg. o el termino del proceso para salir.

CLIC PARA VER TEXTO PLANO
Visual Basic:
  1. Private Sub Command1_Click()
  2. Dim retval As Variant
  3. retval = ShellandWait(Text1.Text)
  4. MsgBox "HOLA"
  5. End Sub

Descarga un ejemplo desde aquí.


Vota este artículo:
1 Estrella2 Estrellas3 Estrellas4 Estrellas5 Estrellas (1 votes, average: 1,00 out of 5)
Loading ... Loading ...

Posts anterior y posterior:
«
»


Posts Relacionados: