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

Question

使用和WaitForSingleObject。我对VBA 6比较陌生，所以我遇到了这个问题。不幸的是，我无法将项目升级到VS 2010.我正在创建一个管道到一个cmd shell并传递一个命令行，然后等待结果。如果我在发送命令的时候运行精确命令，它可以在cmd窗口中正常运行，并且errorlevel总是返回0.但是，如果返回的数据小于4151字节并以258错误超时运行带有WaitForSingleObject的命令返回零如果它是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

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

由于在写入程序结束之前您没有读取管道中的任何内容，并且写入程序被阻止等待读取发生，所以您至少在发生超时之前出现死锁。你明显发现了管道缓冲区的大小。

一个解决方案是不要等待写入过程终止。相反，只需开始阅读，并在管道可用时从管道获取数据。如果你花费太多时间阅读，并且管道还没有干涸，然后你可以放弃并得出结论，该计划耗时太长。