13

我有一个小的 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 打印的输出是文件的旧状态。是否有某种方法可以在我的 shell 命令程序完成之前保持 VB 代码的执行，以便我获得输出文件的正确状态而不是以前的状态？

4

7 回答 7

24

执行此操作所需的秘诀是WaitForSingleObjectfunction，它会阻止应用程序进程的执行，直到指定的进程完成（或超时）。它是 Windows API 的一部分，在将适当的声明添加到您的代码后，可以轻松地从 VB 6 应用程序调用。

该声明看起来像这样：

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

它有两个参数：要等待的进程的句柄，以及指示要等待的最长时间的超时间隔（以毫秒为单位）。如果未指定超时间隔（值为零），则函数不会等待并立即返回。如果您指定无限超时间隔，则该函数仅在进程发出它已完成的信号时返回。

有了这些知识，剩下的唯一任务就是弄清楚如何处理您开始的流程。事实证明这很简单，并且可以通过多种不同的方式完成：

  1. 一种可能性（以及我这样做的方式）是使用同样来自 Windows API 的ShellExecuteEx函数作为 VB 6 中内置函数的替代品Shell。这个版本更加通用和强大，但是就像使用适当的声明一样容易调用。

    它返回它创建的进程的句柄。您所要做的就是将该句柄WaitForSingleObject作为hHandle参数传递给函数，然后您就可以开展业务了。您的应用程序的执行将被阻止（暂停），直到您调用的进程终止。

  2. 另一种可能性是使用该CreateProcess函数（再一次，来自 Windows API）。此函数在与调用进程（即您的 VB 6 应用程序）相同的安全上下文中创建一个新进程及其主线程。

    Microsoft 发布了一篇知识库文章，详细介绍了这种方法，甚至提供了完整的示例实现。您可以在此处找到该文章：如何使用 32 位应用程序来确定外壳进程何时结束。

  3. 最后，也许最简单的方法是利用内置Shell函数的返回值是应用程序任务 ID 这一事实。这是一个唯一的编号，标识你启动的程序，它可以传递给OpenProcess函数以获得可以传递给函数的进程句柄WaitForSingleObject。

    然而，这种方法的简单性确实是有代价的。一个非常显着的缺点是它会导致您的 VB 6 应用程序变得完全没有响应。因为它不会处理 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

这样做：

    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 回答
1

很棒的代码。只是一个小问题：您必须在 ExecCmd 中声明（在 Dim start As STARTUPINFO 之后）：

暗淡如长

如果不这样做，尝试在 VB6 中编译时会出现错误。但效果很好:)

亲切的问候

于 2015-05-18T13:50:37.627 回答
0

在我手中，csaba 解决方案以 intWindowStyle = 0 挂起，并且永远不会将控制权交还给 VB。唯一的出路是在任务管理器中结束进程。

设置 intWindowStyle = 3 并手动关闭窗口将控制权传回

于 2016-01-13T02:21:29.067 回答
0

我找到了一个更好更简单的解决方案：

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

然后你就继续你的代码。希望能帮助到你 ;-）

于 2019-08-23T12:32:52.860 回答