2

使用VBA 6.0和WaitForSingleObject。我比较新，VBA 6所以我遇到了这个问题。不幸的是，我无法将项目升级到 VS 2010。我正在创建一个到 cmd shell 的管道并传递一个命令行，然后等待结果。如果我在发送时运行确切的命令，则从 cmd 窗口它可以正常工作并且errorlevel总是返回 0。但是WaitForSingleObject当返回的数据小于 4151 字节时运行命令返回零，如果是 258 错误则超时4151 或更多。

超时已增加到 60 秒，并且没有任何区别。如果它设置为无限，它永远不会向前移动（我已经让它坐了几个小时）。当从 cmd 运行时，失败的命令会在大约一秒钟内完成输出。这是完整的代码（错误处理被注释掉以便我可以看到返回的数据。它确实显示了前 4150 个字节的数据。）：

  Option Explicit

  Private Type SECURITY_ATTRIBUTES
      nLength As Long
      lpSecurityDescriptor As Long
      bInheritHandle As Long
  End Type

  Private Type PROCESS_INFORMATION
      hProcess As Long
      hThread As Long
      dwProcessId As Long
      dwThreadId As Long
  End Type

  Private Type STARTUPINFO
      cb As Long
      lpReserved As Long
      lpDesktop As Long
      lpTitle As Long
      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 Byte
      hStdInput As Long
      hStdOutput As Long
      hStdError As Long
  End Type

  Private Const WAIT_LONG             As Long = 60000
  Private Const WAIT_INFINITE         As Long = (-1&)
  Private Const STARTF_USESHOWWINDOW  As Long = &H1
  Private Const STARTF_USECOUNTCHARS  As Long = &H8
  Private Const STARTF_USESTDHANDLES  As Long = &H100
  Private Const SW_HIDE               As Long = 0&
  Private Const SW_SHOWNORMAL         As Long = 1

  Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
  Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As Long, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
  Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long
  Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
  Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
  Private Declare Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoA" (lpStartupInfo As STARTUPINFO)
  Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long

  Public Function Redirect(szBinaryPath As String, szCommandLn As String) As String
      Dim tSA_CreatePipe              As SECURITY_ATTRIBUTES
      Dim tSA_CreateProcessPrc        As SECURITY_ATTRIBUTES
      Dim tSA_CreateProcessThrd       As SECURITY_ATTRIBUTES
      Dim tSA_CreateProcessPrcInfo    As PROCESS_INFORMATION
      Dim tStartupInfo                As STARTUPINFO
      Dim hRead                       As Long
      Dim hWrite                      As Long
      Dim bRead                       As Long
      Dim abytBuff()                  As Byte
      Dim lngResult                   As Long
      Dim szFullCommand               As String
      Dim lngExitCode                 As Long
      Dim lngSizeOf                   As Long
      Dim intReturn                   As Integer

      tSA_CreatePipe.nLength = Len(tSA_CreatePipe)
      tSA_CreatePipe.lpSecurityDescriptor = 0&
      tSA_CreatePipe.bInheritHandle = True

      tSA_CreateProcessPrc.nLength = Len(tSA_CreateProcessPrc)
      tSA_CreateProcessThrd.nLength = Len(tSA_CreateProcessThrd)

      If (CreatePipe(hRead, hWrite, tSA_CreatePipe, 0&) <> 0&) Then
          tStartupInfo.cb = Len(tStartupInfo)
          GetStartupInfo tStartupInfo

          With tStartupInfo
              .hStdOutput = hWrite
              .hStdError = hWrite
              .dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES
              .wShowWindow = SW_HIDE
          End With

          szFullCommand = """" & szBinaryPath & """" & " " & szCommandLn
          frmCszKUpNS.FullCommand.Text = szFullCommand

          lngResult = CreateProcess(0&, szFullCommand, tSA_CreateProcessPrc, tSA_CreateProcessThrd, _
                                    True, 0&, 0&, vbNullString, tStartupInfo, tSA_CreateProcessPrcInfo)

          If (lngResult <> 0&) Then
              lngResult = WaitForSingleObject(tSA_CreateProcessPrcInfo.hProcess, WAIT_LONG)

              lngSizeOf = GetFileSize(hRead, 0&)
              If (lngSizeOf > 0) Then
                  ReDim abytBuff(lngSizeOf - 1)
                  If ReadFile(hRead, abytBuff(0), UBound(abytBuff) + 1, bRead, ByVal 0&) Then
                      Redirect = StrConv(abytBuff, vbUnicode)
                  End If
              End If
              Call GetExitCodeProcess(tSA_CreateProcessPrcInfo.hProcess, lngExitCode)
              CloseHandle tSA_CreateProcessPrcInfo.hThread
              CloseHandle tSA_CreateProcessPrcInfo.hProcess

              'If (lngExitCode <> 0&) Then Err.Raise vbObject + 1235&, "GetExitCodeProcess", "Non-zero Application exist code"
              CloseHandle hWrite
              CloseHandle hRead
          Else
              'Err.Raise vbObject + 1236&, "CreateProcess", "CreateProcess Failed, Code: " & Err.LastDllError
          End If
      End If
  End Function
4

1 回答 1

2

管道是缓冲的，但缓冲是有限制的。当缓冲区已满时，写入管道的内容将被阻止，直到缓冲区中有更多可用空间。读取管道时空间变为可用。

由于在编写器终止之前您不会从管道中读取任何内容，并且编写器被阻止等待读取发生，因此您有死锁，至少在您超时之前是这样。您显然已经发现了管道缓冲区的大小。

一种解决方案是不等待写入过程终止。相反，只需开始阅读，您就会从管道中获取可用的数据。如果你花太多时间阅读，并且管道还没有干涸，那么你可以放弃并得出程序耗时太长的结论。

于 2013-06-12T05:03:52.457 回答