0

I have redone some code which was hanging when the result of the szFullCommand returned too much data with WaitForSingleObject. Now I'm getting all of the data into the returned bytes, but how do I tell "ReadFile" to stop? The only marker at the end of the output is a CR/LF pair, but those are all throughout the returned data so I can't really watch for that. Any ideas?

    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
        Dim byteRead(100000)            As Byte
        Dim byteTemp                    As Byte
        Dim intByteCounter              As Integer
        Dim intStillProcessing          As Integer
        Dim intCounter                  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)

            ' All of this works great until there is no data left from the output of the command
            ' Then the ReadFile line hangs forever
            intByteCounter = 0
            intStillProcessing = 1
            While intStillProcessing = 1
                If ReadFile(hRead, byteTemp, 1, bRead, ByVal 0&) Then
                    byteRead(intByteCounter) = byteTemp
                Else
                    intStillProcessing = 0
                End If
                intByteCounter = intByteCounter + 1
            Wend

            ReDim abytBuff(intByteCounter)
            For intCounter = 0 To intByteCounter
                abytBuff(intCounter) = byteRead(intCounter)
            Next intCounter
            Redirect = StrConv(abytBuff, vbUnicode)

            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
user2021539
  • 949
  • 3
  • 14
  • 31
  • You need to use async I/O which is known as overlapped I/O in windows land. – David Heffernan Jun 14 '13 at 20:27
  • Sounds good to me. Do you know of any code examples I can take a look at? – user2021539 Jun 14 '13 at 20:39
  • The non-blocking way to do this is to use WaitForSingleObject. Which does not work for me. Any other ideas? – user2021539 Jun 14 '13 at 22:09
  • What do you mean "does not work for me"? That function is known to work. You don't need any more ideas. – David Heffernan Jun 14 '13 at 22:18
  • Thanks anyway David. But WaitForSingleObject has an upper limit buffer. When that buffer is filled, the function never returns. So that's why it does not work for me. But, no worries. I've found another way around. – user2021539 Jun 15 '13 at 01:51
  • I have no idea what you are talking about. What you describe doesn't sound anything like the WaitForSingleObject that I know. – David Heffernan Jun 15 '13 at 06:59
  • 2
    AFAIK, `CreatePipe()` does not create a pipe that supports overlapped IO. Use `PeekNamedPipe()` instead to detect when, and how much, data is waiting to be read. Despite its name, it works fine with anonymous pipes, not just named pipes. – Remy Lebeau Jun 15 '13 at 08:43
  • @RemyLebeau http://msdn.microsoft.com/en-us/library/windows/desktop/aa365788.aspx – David Heffernan Jun 15 '13 at 09:03
  • 2
    @DavidHeffernan: that page is in the ”Named Pipes" section of documentation. To quote that page: "The ReadFile, WriteFile, TransactNamedPipe, and ConnectNamedPipe functions can be performed asynchronously **only if you enable overlapped mode for the specified pipe handle**". Named pipes provide that ability. Anonymous pipes do not. Granted, an anonymous pipe is implemented using a named pipe, but you don't have access to specify any flags when creating an anonymous pipe. – Remy Lebeau Jun 15 '13 at 14:39
  • @Remy So switch to named pipes then – David Heffernan Jun 15 '13 at 15:01
  • @DavidHeffernan: that would require the calling process to create both the client and server named pipes and connect them together before then calling `CreateProcess()`. That's a lot of extra work just to get access to async I/O, when there are other alternatives. – Remy Lebeau Jun 16 '13 at 03:58
  • @Remy Doesn't seem that onerous to me and anyway the question is "How can I include a Timeout with ReadFile" – David Heffernan Jun 16 '13 at 08:02
  • Does this answer your question? [Breaking ReadFile() blocking - Named Pipe (Windows API)](https://stackoverflow.com/questions/593175/breaking-readfile-blocking-named-pipe-windows-api) – Richard Chambers Nov 03 '21 at 15:58

0 Answers0