Question

使用VBA 6.0和WaitForSingleObject。我对VBA 6比较新，所以我遇到了这个问题。不幸的是，我无法将项目升级到VS 2010.我正在创建一个到cmd shell的管道并传递命令行然后等待结果。如果我在发送时运行确切的命令，则从cmd窗口运行完美，errorlevel始终返回0.但当返回的数据小于4151时，运行带WaitForSingleObject的命令返回零字节数和超时时间为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

Answer 1

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

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

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

当返回的数据超过4150字节时，WaitForSingleObject超时

1 个答案: