web-dev-qa-db-ja.com

VB6でさらにコードを実行する前にシェルプロセスが完了するのを待つ方法

小さなVB6アプリで、Shellコマンドを使用してプログラムを実行しています。プログラムの出力をファイルに保存しています。次に、このファイルを読み取り、VB6のmsgboxを使用して画面に出力を配置します。

これは私のコードが今どのように見えるかです：

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

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

問題は、VBプログラムがmsgboxを使用して出力している出力がファイルの古い状態であることです。以前の状態ではなく出力ファイルの正しい状態を取得できるように、シェルコマンドプログラムが終了するまでVBコードの実行を保持する方法はありますか？

windowswinapivb6processwaitforsingleobject
13
anubhav

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
14
Bob77

私はそれが古い糸であることを知っています、しかし...

Windows Script HostのRunメソッドを使用するのはどうですか？ bWaitOnReturnパラメータがあります。

object.Run（strCommand、[intWindowStyle]、[bWaitOnReturn]）

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

intWindowStyle = 0なので、cmdは非表示になります

8
csaba

このようにしてください：

    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
Farzin Zaker

素晴らしいコード。小さな小さな問題が1つだけあります。ExecCmdで宣言する必要があります（Dim start As STARTUPINFOの後）。

長いとして薄暗い

そうしないと、VB6でコンパイルしようとするとエラーが発生します。しかし、それは素晴らしい働きをします:)

敬具

1
Rui Fernandes

私はより良い簡単な解決策を見つけました：

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

その後、コードを続行します。それが役に立てば幸い ;-）

0
Biel Gonzalez Pibernat

私の手では、csabaソリューションはintWindowStyle = 0でハングし、制御をVBに戻しません。唯一の方法は、タスクマネージャでプロセスを終了することです。

IntWindowStyle = 3に設定し、ウィンドウを閉じると、手動でコントロールが戻されます。

0
Shyaku