Блог

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

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

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

MsgBox Text2String(App.Path amp; "experiments" amp; genname amp; "freq")
  

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

 Option Explicit

Private Const INFINITE = amp;HFFFFFFFFamp;
Private Const SYNCHRONIZE = amp;H100000
Private Const PROCESS_QUERY_INFORMATION = amp;H400amp;

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 amp;H8004AA00, "ShellSync", _
                          "Failed to retrieve exit code, error " _
                        amp; CStr(Err.LastDllError)
            End If
        Else
            Err.Raise amp;H8004AA01, "ShellSync", _
                      "Failed to open child process"
        End If
    Else
        Err.Raise amp;H8004AA02, "ShellSync", _
                  "Failed to Shell child process"
    End If
End Function
  

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

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

объект.Выполнить (strCommand, [intWindowStyle], [bWaitOnReturn])

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

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

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

     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 = amp;H20amp;
   Private Const INFINITE = -1amp;

   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:
      retamp; = CreateProcessA(vbNullString, cmdline$, 0amp;, 0amp;, 1amp;, _
         NORMAL_PRIORITY_CLASS, 0amp;, vbNullString, start, proc)

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

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

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

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

Уменьшать ret до тех пор, пока

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

С уважением

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

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

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

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

а затем вы просто продолжаете работать со своим кодом.
Надеюсь, это поможет 😉