Как дождаться завершения процесса оболочки, прежде чем выполнять следующий код в VB6

Question

У меня есть небольшое приложение VB6, в котором я использую команду Shell для выполнения программы. Я сохраняю вывод программы в файл. Затем я читаю этот файл и вывожу вывод на экран, используя msgbox в VB6.

Вот так выглядит мой код:

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

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

Проблема в том, что вывод, который программа VB печатает с помощью msgbox, является старым состоянием файла. Есть ли способ задержать выполнение кода VB до тех пор, пока не завершится моя командная программа оболочки, чтобы я получил правильное состояние выходного файла, а не предыдущее состояние?

Answer 1

Секретный соус, необходимый для этого, - это WaitForSingleObject функция , которая блокирует выполнение процесса вашего приложения до тех пор, пока указанный процесс не завершится (или не истечет время ожидания). Это часть Windows API, которую легко вызывать из приложения VB 6 после добавления соответствующей декларации в ваш код.

Эта декларация будет выглядеть примерно так:

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

Он принимает два параметра: дескриптор процесса, который вы хотите ждать, и интервал времени ожидания (в миллисекундах), который указывает максимальное время ожидания. Если вы не укажете интервал времени ожидания (значение ноль), функция не будет ждать и сразу же вернется. Если вы укажете бесконечный интервал времени ожидания, функция вернет только , когда процесс сообщит о завершении.

Вооружившись этими знаниями, единственная задача, которая остается, - выяснить, как справиться с процессом, который вы начали. Это оказывается довольно простым и может быть выполнено несколькими различными способами:

1. Одна возможность (и способ, которым я бы это сделал) заключается в использовании функции ShellExecuteEx , также из API Windows, в качестве замены для Shell функция, встроенная в VB 6. Эта версия гораздо более универсальна и мощна, но ее также легко вызвать с помощью соответствующего объявления.

   Возвращает дескриптор процесса, который он создает. Все, что вам нужно сделать, это передать этот дескриптор функции WaitForSingleObject в качестве параметра hHandle, и вы в деле. Выполнение вашей заявки будет заблокировано (приостановлено) до тех пор, пока не завершится вызванный вами процесс.

2. Другая возможность - использовать функцию CreateProcess (еще раз, из Windows API). Эта функция создает новый процесс и его основной поток в том же контексте безопасности, что и вызывающий процесс (т. Е. Ваше приложение VB 6).

   Microsoft опубликовала статью базы знаний, подробно описывающую этот подход, которая даже предоставляет полный пример реализации. Вы можете найти эту статью здесь: Как использовать 32-битное приложение, чтобы определить, когда завершится процесс Shelled .

3. Наконец, возможно, самый простой подход заключается в том, чтобы воспользоваться тем фактом, что возвращаемое значение встроенной функции Shell является идентификатором задачи приложения. Это уникальный номер, который идентифицирует программу, которую вы запустили, и его можно передать в функцию OpenProcess , чтобы получить дескриптор процесса, который можно передать в функцию WaitForSingleObject.

   Однако простота такого подхода обходится дорого. Весьма существенным недостатком является то, что приложение VB 6 станет полностью не отвечающим. Поскольку он не будет обрабатывать сообщения Windows, он не будет реагировать на взаимодействие с пользователем или даже перерисовывать экран.

   Хорошие люди в VBnet сделали полный пример кода доступным в следующей статье: WaitForSingleObject: Определите, когда завершилось приложение Shelled .
   _{Мне бы очень хотелось иметь возможность воспроизвести здесь код, чтобы помочь предотвратить гниение ссылок (VB 6 поднимается там уже много лет; нет никакой гарантии, что эти ресурсы будут существовать вечно), но лицензия на распространение в сам код, по-видимому, явно запрещает это.}

Answer 2

Нет необходимости прибегать к дополнительным усилиям по вызову CreateProcess () и т. Д. Это более или менее дублирует старый код Рэнди Бёрча, хотя он не основан на его примере.Существует только так много способов убрать кошку из кожи.

Здесь у нас есть готовая функция для удобного использования, которая также возвращает код выхода.Перетащите его в статический модуль (.BAS) или включите его в форму или класс.

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

Answer 3

Я знаю, что это старая тема, но ...

Как насчет использования метода запуска Windows Script Host? Имеет параметр bWaitOnReturn.

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

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

intWindowStyle = 0, поэтому cmd будет скрыт

Answer 4

Отличный код.Только одна маленькая проблема: вы должны объявить в ExecCmd (после запуска Dim как STARTUPINFO):

Dim ret as Long

При попытке компиляции в VB6 вы получите ошибку, если вы не«т.Но он прекрасно работает:)

С уважением

Answer 5

Сделайте так:

    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

Ссылка: http://support.microsoft.com/kb/129796

Answer 6

В моих руках решение csaba зависает с intWindowStyle = 0 и никогда не передает управление обратно VB. Единственный выход - завершить процесс в диспетчере задач.

Установка intWindowStyle = 3 и закрытие окна вручную возвращает управление обратно