13

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

これは私のコードが今のように見えるものです:

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

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

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

4

7 に答える 7

24

これを行うために必要な秘密のソースは、指定されたプロセスが完了する（またはタイムアウトする）までアプリケーションのプロセスの実行をブロックするWaitForSingleObject関数です。これはWindowsAPIの一部であり、コードに適切な宣言を追加した後、VB6アプリケーションから簡単に呼び出すことができます。

その宣言は次のようになります。

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

これには、待機するプロセスへのハンドルと、待機する最大時間を示すタイムアウト間隔（ミリ秒単位）の2つのパラメーターが必要です。タイムアウト間隔（ゼロの値）を指定しない場合、関数は待機せずにすぐに戻ります。無限のタイムアウト間隔を指定すると、関数は、プロセスが完了したことを通知した場合にのみ戻ります。

その知識を武器に、残っている唯一のタスクは、開始したプロセスを処理する方法を理解することです。これは非常に単純であり、さまざまな方法で実行できます。

  1. 1つの可能性（および私が行う方法）は、VB 6に組み込まれている関数のドロップイン置換として、これもWindows APIのShellExecuteEx関数Shellを使用することです。このバージョンは、はるかに用途が広く強力ですが、適切な宣言を使用して簡単に呼び出すことができます。

    作成したプロセスへのハンドルを返します。あなたがしなければならないのは、そのハンドルをパラメーターWaitForSingleObjectとして関数に渡すことだけであり、あなたは仕事をしています。hHandle呼び出したプロセスが終了するまで、アプリケーションの実行はブロック（一時停止）されます。

  2. もう1つの可能性は、CreateProcess関数を使用することです（もう一度、Windows APIから）。この関数は、呼び出し元のプロセス（つまり、VB 6アプリケーション）と同じセキュリティコンテキストで、新しいプロセスとそのプライマリスレッドを作成します。

    マイクロソフトは、完全なサンプル実装を提供するこのアプローチを詳述したナレッジベースの記事を公開しています。その記事はここにあります：32ビットアプリケーションを使用してシェル化されたプロセスがいつ終了するかを決定する方法。

  3. 最後に、おそらくこれまでで最も簡単なアプローチは、組み込みShell関数の戻り値がアプリケーションタスクIDであるという事実を利用することです。これは、開始したプログラムを識別する一意の番号であり、関数に渡すことができるプロセスハンドルを取得するためにOpenProcess関数WaitForSingleObjectに渡すことができます。

    ただし、このアプローチの単純さには代償が伴います。非常に重大な欠点は、VB6アプリケーションが完全に応答しなくなることです。Windowsメッセージを処理しないため、ユーザーの操作に応答したり、画面を再描画したりすることはありません。

    VBnetの善良な人々は、次の記事で完全なサンプルコードを利用できるようにしました。WaitForSingleObject：シェル化されたアプリがいつ終了したかを判断します。
    リンク切れを防ぐためにここでコードを再現できるようにしたいと思います（VB 6は数年後に登場します。これらのリソースが永久に存在するという保証はありません）が、コード自体に配布ライセンスが表示されます。明示的にそれを禁止します。

于 2011-04-16T11:04:31.087 に答える
14

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
于 2011-04-16T13:00:52.163 に答える
10

古いスレッドであることは知っていますが...

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 は非表示になります

于 2014-02-28T12:07:35.170 に答える
1

素晴らしいコード。ちょっとした問題が 1 つあります。ExecCmd で宣言する必要があります (Dim start As STARTUPINFO の後):

Dim ret as Long

そうしないと、VB6 でコンパイルしようとするとエラーが発生します。しかし、それはうまく機能します:)

敬具

于 2015-05-18T13:50:37.627 に答える
1

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

    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

于 2011-04-16T10:52:47.127 に答える
0

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

intWindowStyle = 3 を設定してウィンドウを閉じると、手動で制御が戻されます

于 2016-01-13T02:21:29.067 に答える