Non-blocking read of stdin?

Question

I need to have my form-based application check stdin periodically for input, but still perform other processing. Scripting.TextStream.Read() and the ReadFile() API are blocking,

Answer 1

Use vbAdvance add-in to compile following sample with "Build As Console Application" option checked.

Option Explicit

'--- for GetStdHandle
Private Const STD_INPUT_HANDLE          As Long = -10&
Private Const STD_OUTPUT_HANDLE         As Long = -11&
'--- for PeekConsoleInput
Private Const KEY_EVENT                 As Long = 1
'--- for GetFileType
Private Const FILE_TYPE_PIPE            As Long = &H3
Private Const FILE_TYPE_DISK            As Long = &H1

Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Private Declare Function GetConsoleMode Lib "kernel32" (ByVal hConsoleHandle As Long, lpMode As Long) As Long
Private Declare Function SetConsoleMode Lib "kernel32" (ByVal hConsoleHandle As Long, ByVal dwMode As Long) As Long
Private Declare Function PeekNamedPipe Lib "kernel32" (ByVal hNamedPipe As Long, lpBuffer As Any, ByVal nBufferSize As Long, ByVal lpBytesRead As Long, lpTotalBytesAvail As Long, ByVal lpBytesLeftThisMessage As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function OemToCharBuff Lib "user32" Alias "OemToCharBuffA" (ByVal lpszSrc As String, ByVal lpszDst As String, ByVal cchDstLength As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Any) As Long
Private Declare Function CharToOemBuff Lib "user32" Alias "CharToOemBuffA" (ByVal lpszSrc As String, lpszDst As Any, ByVal cchDstLength As Long) As Long
Private Declare Function PeekConsoleInput Lib "kernel32" Alias "PeekConsoleInputA" (ByVal hConsoleInput As Long, lpBuffer As Any, ByVal nLength As Long, lpNumberOfEventsRead As Long) As Long
Private Declare Function ReadConsoleInput Lib "kernel32" Alias "ReadConsoleInputA" (ByVal hConsoleInput As Long, lpBuffer As Any, ByVal nLength As Long, lpNumberOfEventsRead As Long) As Long
Private Declare Function GetFileType Lib "kernel32" (ByVal hFile As Long) As Long

Sub Main()
    Dim hStdIn          As Long
    Dim sBuffer         As String
    Dim dblTimer        As Double

    hStdIn = GetStdHandle(STD_INPUT_HANDLE)
    Do
        sBuffer = sBuffer & ConsoleReadAvailable(hStdIn)
        If dblTimer + 1 < Timer Then
            dblTimer = Timer
            Call OemToCharBuff(sBuffer, sBuffer, Len(sBuffer))
            ConsolePrint "%1: %2" & vbCrLf, Format$(Timer, "0.00"), sBuffer
            sBuffer = vbNullString
        End If
    Loop
End Sub

Private Function ConsoleReadAvailable(ByVal hStdIn As Long) As String
    Dim lType           As Long
    Dim sBuffer         As String
    Dim lChars          As Long
    Dim lMode           As Long
    Dim lAvailChars     As Long
    Dim baBuffer(0 To 512) As Byte
    Dim lEvents         As Long

    lType = GetFileType(hStdIn)
    If lType = FILE_TYPE_PIPE Then
        If PeekNamedPipe(hStdIn, ByVal 0, 0, 0, lAvailChars, 0) = 0 Then
            Exit Function
        End If
    End If
    If lType = FILE_TYPE_DISK Or lAvailChars > 0 Then
        sBuffer = Space(IIf(lAvailChars > 0, lAvailChars, 512))
        Call ReadFile(hStdIn, ByVal sBuffer, Len(sBuffer), lChars, 0)
        ConsoleReadAvailable = Left$(sBuffer, lChars)
    End If
    If GetConsoleMode(hStdIn, lMode) <> 0 Then
        Call SetConsoleMode(hStdIn, 0)
        Do While PeekConsoleInput(hStdIn, baBuffer(0), 1, lEvents) <> 0
            If lEvents = 0 Then
                Exit Do
            End If
            If baBuffer(0) = KEY_EVENT And baBuffer(4) <> 0 Then ' baBuffer(4) = INPUT_RECORD.bKeyDown
                sBuffer = Space(1)
                Call ReadFile(hStdIn, ByVal sBuffer, Len(sBuffer), lChars, 0)
                ConsoleReadAvailable = ConsoleReadAvailable & Left$(sBuffer, lChars)
            Else
                Call ReadConsoleInput(hStdIn, baBuffer(0), 1, lEvents)
            End If
        Loop
        Call SetConsoleMode(hStdIn, lMode)
    End If
End Function

Public Function ConsolePrint(ByVal sText As String, ParamArray A() As Variant) As String
'    Const FUNC_NAME     As String = "ConsolePrint"
    Dim lI              As Long
    Dim sArg            As String
    Dim baBuffer()      As Byte
    Dim dwDummy         As Long

    '--- format
    For lI = UBound(A) To LBound(A) Step -1
        sArg = Replace(A(lI), "%", ChrW$(&H101))
        sText = Replace(sText, "%" & (lI - LBound(A) + 1), sArg)
    Next
    ConsolePrint = Replace(sText, ChrW$(&H101), "%")
    '--- output
    ReDim baBuffer(1 To Len(ConsolePrint)) As Byte
    If CharToOemBuff(ConsolePrint, baBuffer(1), UBound(baBuffer)) Then
        Call WriteFile(GetStdHandle(STD_OUTPUT_HANDLE), baBuffer(1), UBound(baBuffer), dwDummy, ByVal 0&)
    End If
End Function

Answer 2

wqw's answer doesn't work for a form-based application, but the prototypes given there for Peek/ReadConsoleInput allow for one that does:

Private Declare Function AllocConsole Lib "kernel32" () As Long
Private Declare Function FreeConsole Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetStdHandle Lib "kernel32" (ByVal nStdHandle As Long) As Long
Private Declare Function PeekConsoleInput Lib "kernel32" Alias "PeekConsoleInputA" (ByVal hConsoleInput As Long, lpBuffer As Any, ByVal nLength As Long, lpNumberOfEventsRead As Long) As Long
Private Declare Function ReadConsoleInput Lib "kernel32" Alias "ReadConsoleInputA" (ByVal hConsoleInput As Long, lpBuffer As Any, ByVal nLength As Long, lpNumberOfEventsRead As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Long) As Long
Private Declare Function SetConsoleMode Lib "kernel32" (ByVal hConsoleInput As Long, dwMode As Long) As Long

Private Const STD_INPUT_HANDLE As Long = -10& ' GetStdHandle()

Private Const KEY_EVENT As Long = 1 ' PeekConsoleInput()

Private Const ENABLE_PROCESSED_INPUT As Long = &H1 ' SetConsoleMode()
Private Const ENABLE_ECHO_INPUT As Long = &H4

Dim hStdIn As Long

Private Sub Form_Load()

    AllocConsole

    hStdIn = GetStdHandle(STD_INPUT_HANDLE)
    SetConsoleMode hStdIn, ENABLE_PROCESSED_INPUT ' Or ENABLE_ECHO_INPUT ' uncomment to see the characters typed (for debugging)

    Timer1.Enabled = True

    Exit Sub

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

    CloseHandle hStdIn
    FreeConsole

End Sub

Private Sub Timer1_Timer()

    Dim bytesRead As Long
    Dim buffer As String
    Dim baBuffer(0 To 512) As Byte
    Dim lEvents As Long

    PeekConsoleInput hStdIn, baBuffer(0), 1, lEvents
    If lEvents > 0 Then
        If baBuffer(0) = KEY_EVENT And baBuffer(4) <> 0 Then ' baBuffer(4) = INPUT_RECORD.bKeyDown
            buffer = Space$(1)
            Call ReadFile(hStdIn, ByVal buffer, Len(buffer), bytesRead, 0)

            ' buffer now contains one byte read from console
            ' Statements to process go here.

        Else
            Call ReadConsoleInput(hStdIn, baBuffer(0), 1, lEvents)
        End If
    End If
End Sub

PeekNamedPipe, GetConsoleMode and PeekConsoleInput will all return zero if your app isn't a true VB6 console app (though all that may be required is linking with the console subsystem, e.g., "C:\Program Files\Microsoft Visual Studio\vb98\LINK.EXE" /EDIT /SUBSYSTEM:CONSOLE MyApp.exe, I haven't tested it that far). They still work, however, at least Peek... does.

It is key that only one byte is read on each pass, as reading what is in baBuffer is problematic past the first record (INPUT_RECORD structure), but one byte at a time non-blocking is better than none at all. For me, Timer1 is set at 100 ms, but a better setting might be 55 ms, the events time slice.

Also key is that ReadConsoleInput is non-blocking if there is an event present on stdin, not just a key to be read. Using it when the recognized event isn't a key, effectively clears the event, allowing the application to proceed. It is possible to use this to read the bytes from the buffer without using ReadFile at all:

PeekConsoleInput hStdIn, baBuffer(0), 1, lEvents
If lEvents > 0 Then
    Call ReadConsoleInput(hStdIn, baBuffer(0), 1, lEvents)
    If baBuffer(0) = KEY_EVENT And baBuffer(4) <> 0 Then
        ' Chr(baBuffer(14)) now produces the character typed...

This hasn't been tested for reading true human input, except in the simplest debugging during construction, but it does work and should allow most VB6 form-based apps to effectively use a console. Thank you wqw!

Answer 3

I am afraid that I haven't managed to get this to work as of yet, however someone else might be able to have a go. The ideas was to use asynchronous I/O with the console std input (I assume the idea of your app is to allow people to write directly into the console window, and read the input as it comes).

I separated off all the API stuff into a module (MAsynchConsole):

Option Explicit

Private Const GENERIC_READ          As Long = &H80000000
Private Const GENERIC_WRITE         As Long = &H40000000
Private Const OPEN_EXISTING         As Long = 3&
Private Const FILE_FLAG_OVERLAPPED  As Long = &H40000000
Private Const FILE_SHARE_READ       As Long = &H1

Private Const FILE_FLAG_NO_BUFFERING As Long = &H20000000

Private Type OVERLAPPED
    Internal                    As Long
    InternalHigh                As Long
    OffsetOrPointer             As Long
    OffsetHigh                  As Long
    hEvent                      As Long
End Type

Private Type OVERLAPPED_ENTRY
    lpCompletionKey             As Long
    lpOverlapped                As Long ' pointer to OVERLAPPED
    Internal                    As Long
    dwNumberOfBytesTransferred  As Long
End Type

Private Declare Function AllocConsole Lib "kernel32" () As Long

Private Declare Function CancelIo Lib "Kernel32.dll" ( _
    ByVal hFile As Long _
) As Long

Private Declare Function CreateFile Lib "Kernel32.dll" Alias "CreateFileW" ( _
    ByVal lpFileName As Long, _
    ByVal dwDesiredAccess As Long, _
    ByVal dwShareModen As Long, _
    ByRef lpSecurityAttributes As Any, _
    ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long _
) As Long

Private Declare Function FreeConsole Lib "kernel32" () As Long

Private Declare Function GetStdHandle Lib "kernel32" ( _
    ByVal nStdHandle As Long _
) As Long


Private Declare Function ReadFile Lib "Kernel32.dll" ( _
    ByVal hFile As Long, _
    ByVal lpBuffer As Long, _
    ByVal nNumberOfBytesToRead As Long, _
    ByRef lpNumberOfBytesRead As Long, _
    ByRef lpOverlapped As OVERLAPPED _
) As Long

Private Declare Function ReadFileEx Lib "Kernel32.dll" ( _
    ByVal hFile As Long, _
    ByVal lpBuffer As Long, _
    ByVal nNumberOfBytesToRead As Long, _
    ByRef lpOverlapped As OVERLAPPED, _
    ByVal lpCompletionRoutine As Long _
) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private m_hStdIn                    As Long
Private m_uOverlapped               As OVERLAPPED
Private m_sUnicodeBuffer            As String

Private m_oReadCallback             As IReadCallback

Public Sub CloseConsole()

    CancelIo m_hStdIn
    Set m_oReadCallback = Nothing
    m_sUnicodeBuffer = vbNullString
    CloseHandle m_hStdIn

    FreeConsole

End Sub

Private Sub FileIOCompletionRoutine( _
    ByVal dwErrorCode As Long, _
    ByVal dwNumberOfBytesTransfered As Long, _
    ByRef uOverlapped As OVERLAPPED _
)

    On Error GoTo ErrorHandler

    m_oReadCallback.DataRead "FileIOCompletionRoutine"
    m_oReadCallback.DataRead "dwErrorCode = " & CStr(dwErrorCode)

    If dwErrorCode Then
        MsgBox "Error = " & CStr(dwErrorCode)
        CloseConsole
        Exit Sub
    End If

    m_oReadCallback.DataRead "dwNumberOfBytesTransfered = " & CStr(dwNumberOfBytesTransfered)

    m_oReadCallback.DataRead Left$(m_sUnicodeBuffer, dwNumberOfBytesTransfered)

Exit Sub

ErrorHandler:
    '
End Sub

Public Sub OpenConsoleForInput(ByRef the_oReadCallback As IReadCallback)

    Dim sFileName                   As String

    On Error GoTo ErrorHandler

    Set m_oReadCallback = the_oReadCallback

    AllocConsole

    'm_hStdIn = GetStdHandle(-10&)

    sFileName = "CONIN$"
    'm_hStdIn = CreateFile(StrPtr(sFileName), GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING,  0&, 0&)
    m_hStdIn = CreateFile(StrPtr(sFileName), GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, 0&)

    m_oReadCallback.DataRead "m_hStdIn = " & CStr(m_hStdIn)
    m_oReadCallback.DataRead "LastError = " & CStr(Err.LastDllError)

    m_sUnicodeBuffer = Space$(8192)

Exit Sub

ErrorHandler:
    Err.Raise Err.Number, Err.Source, Err.Description
End Sub

Public Sub Read()

    Dim nRet                            As Long
    Dim nBytesRead                      As Long

    On Error GoTo ErrorHandler

    m_oReadCallback.DataRead "About to call ReadFileExe"

    'm_uOverlapped.OffsetHigh = 0&
    'm_uOverlapped.OffsetOrPointer = 0&
    'nRet = ReadFile(m_hStdIn, StrPtr(m_sUnicodeBuffer), LenB(m_sUnicodeBuffer), nBytesRead, m_uOverlapped)
    nRet = ReadFileEx(m_hStdIn, StrPtr(m_sUnicodeBuffer), LenB(m_sUnicodeBuffer), m_uOverlapped, AddressOf FileIOCompletionRoutine)

    m_oReadCallback.DataRead "nRet = " & CStr(nRet)

    m_oReadCallback.DataRead "nBytesRead = " & CStr(nBytesRead)

    If nRet = 0 Then
        m_oReadCallback.DataRead "Err.LastDllError = " & CStr(Err.LastDllError)
    Else
        m_oReadCallback.DataRead StrConv(Left$(m_sUnicodeBuffer, nBytesRead), vbUnicode)
    End If

Exit Sub

ErrorHandler:
    Err.Raise Err.Number, Err.Source, Err.Description
End Sub

This relies on an interface (IReadCallback) to communicate with the main GUI.

Option Explicit

Public Sub DataRead(ByRef out_sData As String)
    '
End Sub

This is my sample form (FAsynchConsoleTest) - which uses a Timer (Timer) and RichTextBox (txtStdIn):

Option Explicit

Implements IReadCallback

Private Sub Form_Load()

    MAsynchConsole.OpenConsoleForInput Me

    Timer.Enabled = True

End Sub

Private Sub Form_Unload(Cancel As Integer)

    MAsynchConsole.CloseConsole

End Sub

Private Sub IReadCallback_DataRead(out_sData As String)

    txtStdIn.SelStart = Len(txtStdIn.Text)
    txtStdIn.SelText = vbNewLine & out_sData

End Sub

Private Sub mnuTimerOff_Click()

    Timer.Enabled = False

End Sub

Private Sub mnuTimerOn_Click()

    Timer.Enabled = True

End Sub

Private Sub Timer_Timer()

    MAsynchConsole.Read

End Sub

Unfortunately, whilst CreateFile() using FILE_FLAG_OVERLAPPED should create a file handle that can be used with async I/O, and the handle seems valid, ReadFileEx() returns 0, and GetLastError is 6, which is:

//
// MessageId: ERROR_INVALID_HANDLE
//
// MessageText:
//
// The handle is invalid.
//
#define ERROR_INVALID_HANDLE             6L

The console, interestingly, is frozen whilst this all happens.

Anyone else have any ideas? The docs seem to suggest that if you use CreateFile() with a console device name, the parameter is ignored.