web-dev-qa-db-fra.com

Comment attendre la fin d'un processus Shell avant d'exécuter du code supplémentaire dans VB6

J'ai une petite application VB6 dans laquelle j'utilise la commande Shell pour exécuter un programme. Je stocke la sortie du programme dans un fichier. Je suis alors en train de lire ce fichier et d’afficher la sortie à l’écran à l’aide d’une boîte aux lettres dans VB6.

Voici à quoi ressemble mon code:

sCommand = "\evaluate.exe<test.txt "
Shell ("cmd.exe /c" & App.Path & sCommand)

MsgBox Text2String(App.Path & "\experiments\" & genname & "\freq")

Le problème est que la sortie imprimée par le programme VB à l'aide de la msgbox correspond à l'ancien état du fichier. Existe-t-il un moyen de suspendre l'exécution du code VB jusqu'à la fin du programme de commande Shell afin d'obtenir l'état correct du fichier de sortie et non un état précédent?

windowswinapivb6processwaitforsingleobject
13
anubhav

La recette secrète nécessaire à cette opération est la fonction WaitForSingleObject , qui bloque l'exécution du processus de votre application jusqu'à ce que le processus spécifié soit terminé (ou expire). Cela fait partie de l'API Windows, facilement appelé depuis une application VB 6 après avoir ajouté la déclaration appropriée à votre code.

Cette déclaration ressemblerait à quelque chose comme ceci:

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

Deux paramètres sont nécessaires: un descripteur du processus que vous souhaitez attendre et l'intervalle de temporisation (en millisecondes) qui indique la durée maximale pendant laquelle vous souhaitez attendre. Si vous ne spécifiez pas de délai d'expiration (une valeur de zéro), la fonction n'attend pas et retourne immédiatement. Si vous spécifiez un intervalle de temps infini, la fonction renvoie uniquement lorsque le processus en indique la fin.

Armée de cette connaissance, la seule tâche qui reste à faire est de déterminer comment gérer le processus que vous avez démarré. Cela s'avère assez simple et peut être accompli de différentes manières:

  1. Une possibilité (et la façon dont je le ferais) consiste à utiliser la fonction ShellExecuteEx , également à partir de l'API Windows, en remplacement instantané de la fonction Shell intégrée à VB 6. Cette version est beaucoup plus polyvalente et puissante, mais elle est tout aussi facilement appelée à l’aide de la déclaration appropriée.

    Il renvoie un descripteur au processus qu'il crée. Tout ce que vous avez à faire est de transmettre ce descripteur à la fonction WaitForSingleObject en tant que paramètre hHandle et vous êtes en affaires. L'exécution de votre application sera bloquée (suspendue) jusqu'à la fin du processus que vous avez appelé.

  2. Une autre possibilité consiste à utiliser la fonction CreateProcess (à nouveau, à partir de l'API Windows). Cette fonction crée un nouveau processus et son thread principal dans le même contexte de sécurité que le processus appelant (c'est-à-dire votre application VB 6). 

    Microsoft a publié un article de la base de connaissances détaillant cette approche, qui fournit même un exemple complet d'implémentation. Vous pouvez trouver cet article ici: Comment utiliser une application 32 bits pour déterminer la fin d'un processus shells .

  3. Enfin, l’approche la plus simple consiste peut-être à tirer parti du fait que la valeur de retour de la fonction Shell intégrée est un ID de tâche d’application. Il s'agit d'un numéro unique qui identifie le programme que vous avez démarré. Il peut être transmis à la fonction OpenProcess pour obtenir un descripteur de processus pouvant être transmis à la fonction WaitForSingleObject. 

    Cependant, la simplicité de cette approche ne a un coût. Un inconvénient très important est que votre application VB 6 ne répondra plus du tout. Dans la mesure où il ne traitera pas les messages Windows, il ne répondra pas aux interactions de l'utilisateur et ne redessinera même pas l'écran. 

    Les bonnes personnes de VBnet ont mis à disposition un exemple de code complet dans l’article suivant: WaitForSingleObject: Détermine le moment où une application shells est terminée .
    J'adorerais pouvoir reproduire le code ici pour aider à lutter contre la pourriture des liens (VB 6 y monte depuis des années; rien ne garantit que ces ressources seront toujours présentes), mais la licence de distribution dans le code lui-même apparaît d'interdire explicitement cela.

22
Cody Gray

Il n'est pas nécessaire de recourir à l'effort supplémentaire d'appeler CreateProcess (), etc. Cela duplique plus ou moins l'ancien code de Randy Birch, bien qu'il ne soit pas basé sur son exemple. Il n'y a pas beaucoup de façons de peler un chat.

Ici, nous avons une fonction préemballée pour une utilisation pratique, qui renvoie également le code de sortie. Déposez-le dans un module statique (.BAS) ou incluez-le en ligne dans un formulaire ou une classe.

Option Explicit

Private Const INFINITE = &HFFFFFFFF&
Private Const SYNCHRONIZE = &H100000
Private Const PROCESS_QUERY_INFORMATION = &H400&

Private Declare Function CloseHandle Lib "kernel32" ( _
    ByVal hObject As Long) 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 WaitForSingleObject Lib "kernel32" ( _
    ByVal hHandle As Long, _
    ByVal dwMilliseconds As Long) As Long

Public Function ShellSync( _
    ByVal PathName As String, _
    ByVal WindowStyle As VbAppWinStyle) As Long
    'Shell and wait.  Return exit code result, raise an
    'exception on any error.
    Dim lngPid As Long
    Dim lngHandle As Long
    Dim lngExitCode As Long

    lngPid = Shell(PathName, WindowStyle)
    If lngPid <> 0 Then
        lngHandle = OpenProcess(SYNCHRONIZE _
                             Or PROCESS_QUERY_INFORMATION, 0, lngPid)
        If lngHandle <> 0 Then
            WaitForSingleObject lngHandle, INFINITE
            If GetExitCodeProcess(lngHandle, lngExitCode) <> 0 Then
                ShellSync = lngExitCode
                CloseHandle lngHandle
            Else
                CloseHandle lngHandle
                Err.Raise &H8004AA00, "ShellSync", _
                          "Failed to retrieve exit code, error " _
                        & CStr(Err.LastDllError)
            End If
        Else
            Err.Raise &H8004AA01, "ShellSync", _
                      "Failed to open child process"
        End If
    Else
        Err.Raise &H8004AA02, "ShellSync", _
                  "Failed to Shell child process"
    End If
End Function
14
Bob77

Je sais que c'est un vieux fil, mais ...

Comment utiliser la méthode Run de Windows Script Host? Il a un paramètre bWaitOnReturn.

object.Run (strCommand, [intWindowStyle], [bWaitOnReturn]) 

Set oShell = CreateObject("WSCript.Shell")
oShell.run "cmd /C " & App.Path & sCommand, 0, True

intWindowStyle = 0, donc cmd sera caché

6
csaba

Fait comme ça :

    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 Type PROCESS_INFORMATION
      hProcess As Long
      hThread As Long
      dwProcessID As Long
      dwThreadID As Long
   End Type

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

   Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
      lpApplicationName As String, 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 String, _
      lpStartupInfo As STARTUPINFO, lpProcessInformation As _
      PROCESS_INFORMATION) As Long

   Private Declare Function CloseHandle Lib "kernel32" _
      (ByVal hObject As Long) As Long

   Private Declare Function GetExitCodeProcess Lib "kernel32" _
      (ByVal hProcess As Long, lpExitCode As Long) As Long

   Private Const NORMAL_PRIORITY_CLASS = &H20&
   Private Const INFINITE = -1&

   Public Function ExecCmd(cmdline$)
      Dim proc As PROCESS_INFORMATION
      Dim start As STARTUPINFO

      ' Initialize the STARTUPINFO structure:
      start.cb = Len(start)

      ' Start the shelled application:
      ret& = CreateProcessA(vbNullString, cmdline$, 0&, 0&, 1&, _
         NORMAL_PRIORITY_CLASS, 0&, vbNullString, start, proc)

      ' Wait for the shelled application to finish:
         ret& = WaitForSingleObject(proc.hProcess, INFINITE)
         Call GetExitCodeProcess(proc.hProcess, ret&)
         Call CloseHandle(proc.hThread)
         Call CloseHandle(proc.hProcess)
         ExecCmd = ret&
   End Function

   Sub Form_Click()
      Dim retval As Long
      retval = ExecCmd("notepad.exe")
      MsgBox "Process Finished, Exit Code " & retval
   End Sub

Référence: http://support.Microsoft.com/kb/129796

1
Farzin Zaker

Excellent code. Juste un petit problème: vous devez déclarer dans ExecCmd (après Dim start As STARTUPINFO):

Dim ret aussi long

Si vous ne le faites pas, vous obtiendrez une erreur en essayant de compiler dans VB6. Mais ça marche très bien :)

Sincères amitiés

1
Rui Fernandes

Dans mes mains, la solution csaba est suspendue avec intWindowStyle = 0 et ne rend jamais le contrôle à VB. Le seul moyen de sortir est de mettre fin au processus dans le gestionnaire de tâches.

La définition de intWindowStyle = 3 et la fermeture manuelle de la fenêtre redonnent le contrôle

0
Shyaku