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

12
process vb6 waitforsingleobject winapi windows

6 ответов

секретный соус нужно делать это WaitForSingleObject функции, который блокирует выполнение процесса вашего приложения до завершения указанного процесса (или тайм-аута). Это часть API Windows, легко вызывается из приложения 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. Эта версия гораздо более универсальна и мощна, но так же легко вызывается с помощью соответствующего объявления.

    она возвращает дескриптор процесса создает. Все, что вам нужно сделать, это передать, что дескриптор

21

нет необходимости прибегать к дополнительным усилиям вызова 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
14

Я знаю, что это старый нить, но...

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

6

делаю так :

    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

1

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

Дим рет как долго

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

с уважением

1

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

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

0