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

使用

VBA 6.0

和

WaitForSingleObject

。我对

VBA6

比较陌生，所以我遇到了这个问题。不幸的是，我无法将项目升级到VS 2010。我正在创建一个到cmdshell的管道，并传递一个命令行，然后等待结果。如果在发送命令时运行确切的命令，则在cmd窗口中，它工作正常，

errorlevel

始终返回0。但是，当返回的数据小于4151字节时，使用

WaitForSingleObject

运行命令将返回零，如果返回的数据小于4151字节或更大，则将超时并出现258错误

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

选项显式
私有类型安全属性
长度等于
lpSecurityDescriptor的长度
长柄
端型
私有类型进程信息
hProcess尽可能长
hThread尽可能长
dwProcessId尽可能长
dwThreadId尽可能长
端型
私有类型STARTUPINFO
只要
保留的时间尽可能长
lpDesktop尽可能长
尽可能长的标题
dwX尽可能长
只要
dwXSize尽可能长
尽可能长
dwXCountChars的长度为
德怀康查斯一样长
dwFillAttribute尽可能长
把旗子拖得一样长
wShowWindow作为整数
cbReserved2为整数
lpReserved2作为字节
HST输入长度为
hst输出长度
hStdError尽可能长
端型
私人常数等待时间=60000
Private Const WAIT_无限长=（-1&）
Private Const STARTF_USESHOWWINDOW作为Long=&H1
Private Const STARTF_USECOUNTCHARS As Long=&H8
私人Const STARTF_USESTDHANDLES的长度=&H100
私有常量SW_隐藏长度=0&
专用常量SW_SHOWNORMAL，只要长=1
私有声明函数CreatePipe Lib“kernel32”（phReadPipe为Long，phWritePipe为Long，lpPipeAttributes为SECURITY_属性，ByVal nSize为Long）为Long
私有声明函数CreateProcess Lib“kernel32”别名“CreateProcessA”（ByVal lpApplicationName为长，ByVal lpCommandLine为字符串，lpProcessAttributes为任意，lpThreadAttributes为任意，ByVal bInheritHandles为长，ByVal dwCreationFlags为长，lpEnvironment为任意，ByVal lpCurrentDriectory为字符串，lpStartupInfo为STARTUPINFO，lpProcessInformation为进程信息）为长
私有声明函数ReadFile Lib“kernel32”（ByVal hFile为长，lpBuffer为任意，ByVal nNumberOfBytesToRead为长，lpNumberOfBytesRead为长，lpOverlapped为任意）为长
私有声明函数CloseHandle Lib“kernel32”（ByVal hObject As Long）为Long
私有声明函数WaitForSingleObject库“kernel32”（ByVal hHandle尽可能长，ByVal DWM尽可能长）尽可能长
私有声明函数getExitCode进程库“kernel32”（ByVal hProcess As Long，lpExitCode As Long）为Long
私有声明子GetStartupInfo库“内核32”别名“GetStartupInfoA”（lpStartupInfo作为STARTUPINFO）
私有声明函数GetFileSize Lib“kernel32”（ByVal hFile为Long，lpFileSizeHigh为Long）为Long
公共函数重定向（szBinaryPath作为字符串，szCommandLn作为字符串）作为字符串
Dim tSA_CreatePipe作为安全属性
Dim tSA_CreateProcessPrc作为安全属性
Dim tSA_CreateProcessThrd作为安全属性
Dim tSA_CreateProcessPrcInfo作为过程信息
将tStartupInfo设置为STARTUPINFO
使线程变长
写得一样长
长面包
Dim abytBuff（）作为字节
暗淡的结果和长的一样
Dim szFullCommand作为字符串
长码
变暗lngSizeOf尽可能长
以整数形式返回
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）
如果（CreatePipe（hRead，hWrite，tSA_CreatePipe，0&）0&），那么
tStartupInfo.cb=Len（tStartupInfo）
GetStartupInfo TSStartupInfo
使用tStartupInfo
.hStdOutput=hWrite
.hStdError=hWrite
.dwFlags=STARTF_USESHOWWINDOW或STARTF_USESTDHANDLES
.wShowWindow=SW\u HIDE
以
szFullCommand=“”&szBinaryPath&“&”&szCommandLn
frmCszKUpNS.FullCommand.Text=szFullCommand
lngResult=CreateProcess（0&，szFullCommand，tSA_CreateProcessPrc，tSA_CreateProcessThrd_
True、0&、0&、vbNullString、TSStartupInfo、tSA_CreateProcessPrcInfo）
如果（lngResult 0&），则
lngResult=WaitForSingleObject（tSA_CreateProcessPrcInfo.hProcess，WAIT_LONG）
lngSizeOf=GetFileSize（线程，0&）
如果（lngSizeOf>0），则
ReDim abytBuff（lngSizeOf-1）
如果ReadFile（hRead，abytBuff（0），UBound（abytBuff）+1，bRead，ByVal 0&），那么
重定向=StrConv（abytBuff，vbUnicode）
如果结束
如果结束
调用GetExitCodeProcess（tSA_CreateProcessPrcInfo.hProcess，lngExitCode）
CloseHandle tSA_CreateProcessPrcInfo.hThread
CloseHandle tSA_CreateProcessPrcInfo.hProcess
'如果（lngExitCode 0&），则错误提升vbObject+12
  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