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

У меня есть небольшое приложение 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 до тех пор, пока моя командная программа оболочки не завершится, чтобы получить правильное состояние выходного файла, а не предыдущее состояние?

Ответы

Ответ 1

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

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

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

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

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

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

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

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

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

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

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

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

Ответ 2

Нет необходимости прибегать к дополнительным усилиям вызова CreateProcess() и т.д. Это более или менее дублирует старый код Randy Birch, хотя он не был основан на его примере. Существует так много способов скинуть кошку.

Здесь у нас есть предварительно упакованная функция для удобного использования, которая также возвращает код выхода. Внесите его в статический (.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

Ответ 3

Я знаю, что это старый поток, но...

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

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

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

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

Ответ 4

Сделайте следующее:

    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

Ответ 5

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

Dim ret as Long

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

С уважением

Ответ 6

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

Настройка intWindowStyle = 3 и закрытие окна вручную передает управление назад

Ответ 7

Я нашел лучше & более простое решение:

Dim processID = Shell("C:/path/to/process.exe " + args
Dim p As Process = Process.GetProcessById(processID)
p.WaitForExit()

и тогда вы просто продолжаете свой код. Надеюсь, это поможет ;-)